久々Ruby勉強。
Methodオブジェクトとか、lambda記法とかを備忘メモ。 Commandパターンとかに使おうかなぁと。
続きを読む標題の通り。
Sub ブック一覧() Dim wb As Workbook Dim sheet As Worksheet Debug.Print "ThisBook :" & ThisWorkbook.Name For Each wb In Workbooks Debug.Print wb.Name If wb.Name Like "*探し物*" Then Debug.Print "探し物が見つかりました! :" & wb.Name End If For Each sheet In wb.Worksheets Debug.Print " Sheet: " & sheet.Name Next sheet Next wb End Sub
またも深夜のVBA探索。。。
Sub フィルタチェック() Dim i As Long, title As String Dim f As Filter Dim af As AutoFilter If ActiveSheet.AutoFilterMode Then For i = 1 To ActiveSheet.AutoFilter.Filters.Count Set f = ActiveSheet.AutoFilter.Filters(i) With f If f.On Then title = ActiveSheet.AutoFilter.Range.Cells(1, i) Debug.Print f.Operator Select Case f.Operator Case 0 Debug.Print title & f.Criteria1 & " で絞り込まれています" Case xlAnd Debug.Print title & f.Criteria1 & " and " & title & f.Criteria2 & " で絞り込まれています" Case xlOr Debug.Print title & f.Criteria1 & " or " & title & f.Criteria2 & " で絞り込まれています" Case xlFilterValues Dim j As Long For j = LBound(f.Criteria1) To UBound(f.Criteria1) Debug.Print title & f.Criteria1(j) & " で絞り込まれています" Next j Case Else End Select End If End With Next i Debug.Print "レコード数:" & ActiveSheet.AutoFilter.Range.Columns(1).SpecialCells(xlCellTypeVisible).Count - 1 End If End Sub
ActiveSheet.AutoFilter.Range.AutoFilter Field:=3, Criteria1:="=00001", _ Operator:=xlOr, Criteria2:="=00002"
EXCELと格闘する日々に効率化を。。
職場に役立ちそうな EXCEL VBA を深夜自宅で勉強中。。。眠い。
なんだか20年くらい前の仕事をしている気分。
Visual Basic for Applications - Wikipedia
Sub OpenBookSheet(ByVal FilePath As String, ByVal Sheet As String, ByVal NewSheet As String) Const xKey_Col = 1 'キー列番号 Const xHeads = 1 '見出しの行数 On Error Resume Next Application.ScreenUpdating = False Application.DisplayAlerts = False Dim TargetBook As Workbook Set TargetBook = Workbooks.Open(Filename:=FilePath) ThisWorkbook.Activate ' アクティブシートを記憶 Dim OldSheet As Worksheet Set OldSheet = ActiveSheet ' 新シートを作成 Dim NewWorkSheet As Worksheet ThisWorkbook.Worksheets(NewSheet).Delete Set NewWorkSheet = Worksheets.Add() NewWorkSheet.Name = NewSheet With TargetBook.Sheets(Sheet) xLast = .Cells(Rows.Count, xKey_Col).End(xlUp).Row Application.CutCopyMode = False .UsedRange.Copy NewWorkSheet.Range("A1").PasteSpecial xlPasteValuesAndNumberFormats End With TargetBook.Close OldSheet.Activate Application.CutCopyMode = False Application.DisplayAlerts = True Application.ScreenUpdating = True End Sub Sub DeleteRow(ByVal Sheet As String, ByVal StartTarget As String, ByVal EndTarget As String) '行削除 ThisWorkbook.Worksheets(Sheet).Range(StartTarget & ":" & EndTarget).Delete End Sub Sub 集計開始() ' ブックと同一のパスからファイルを検索 Dim buf As String, cnt As Long Dim Col As Long Dim Path As String Dim File As String Dim Sheet As String Dim NewSheet As String Dim PathFile As String Dim Target As String Path = ThisWorkbook.Path For cnt = 0 To 5 File = Cells(cnt + 6, 2) Sheet = Cells(cnt + 6, 3) NewSheet = Cells(cnt + 6, 4) If File = "" Then Exit For If Sheet = "" Then Exit For If NewSheet = "" Then Exit For ' ファイル名 記録 PathFile = Path & "\\" & File buf = Dir(PathFile) Cells(cnt + 6, 6) = buf ' シートのコピー OpenBookSheet Path & "\\" & buf, Sheet, NewSheet ' 範囲削除 For Col = 0 To 10 Step 2 StartTarget = Cells(cnt + 6, Col + 7) EndTarget = Cells(cnt + 6, Col + 8) If StartTarget <> "" And EndTarget <> "" Then DeleteRow NewSheet, StartTarget, EndTarget End If Next Col Next cnt End Sub