Excel VBA 逆引き集 | ログ検索

Excel VBA
スポンサーリンク

ログ検索

長いログから「特定キーワード」「期間」「レベル別」を瞬時に抜き出すためのテンプレを、初心者でも安全に使える形でまとめました。シート内ログ、外部テキスト/CSVログの双方に対応します。

選び方の指針

  • シート内のログを検索: Range.Find（全件列挙）、InStr（柔軟条件）、AutoFilter（見た目で絞る）
  • 外部ログファイル（txt/csv）を検索: 行読み込み（Line Input）、QueryTables（CSVレイアウト保持）、正規表現（パターン抽出）
  • 大量＆繰り返し検索: 先に配列へ読み込み、辞書でインデックス化（キーワード・レベル別）

シート内ログの基本テンプレ

1) キーワードの部分一致を全件列挙（Find＋FindNext）

Sub Log_FindAll()
    Dim rng As Range, hit As Range, first As String, kw As String
    Set rng = Range("A2:A100000")  'ログ列
    kw = "ERROR"

    Set hit = rng.Find(What:=kw, LookIn:=xlValues, LookAt:=xlPart, MatchCase:=False)
    If hit Is Nothing Then
        MsgBox "該当なし": Exit Sub
    End If

    first = hit.Address
    Do
        '前方一致が必要なら Left で追加判定
        Debug.Print hit.Row, hit.Value
        hit.Interior.Color = RGB(255, 235, 156) '色付け例
        Set hit = rng.FindNext(hit)
    Loop While Not hit Is Nothing And hit.Address <> first
End Sub
VB
  • ポイント:
    • LookAt=xlPart: 「含む」検索。誤ヒット抑制は前後確認や正規表現へ。
    • 無限ループ防止: 最初のアドレスに戻ったら終了。

2) InStrで柔軟検索（複数キーワード OR／AND）

Sub Log_Search_InStr()
    Dim last As Long, r As Long, s As String
    last = Cells(Rows.Count, "A").End(xlUp).Row
    For r = 2 To last
        s = CStr(Cells(r, "A").Value)
        If InStr(1, s, "ERROR", vbTextCompare) > 0 Or InStr(1, s, "CRITICAL", vbTextCompare) > 0 Then
            Rows(r).Copy Destination:=Worksheets("抽出").Rows(Worksheets("抽出").Cells(Rows.Count, 1).End(xlUp).Row + 1)
        End If
    Next
End Sub
VB
  • ポイント:
    • vbTextCompare: 大小文字無視。AND/ORや多条件が書きやすい。

3) AutoFilterで見た目だけ絞る（最短）

Sub Log_Filter_ErrorWarn()
    With Range("A1").CurrentRegion
        .AutoFilter Field:=1, Criteria1:="*ERROR*", Operator:=xlOr, Criteria2:="*WARN*"
        .SpecialCells(xlCellTypeVisible).Copy Worksheets("抽出").Range("A1")
        .AutoFilter '解除
    End With
End Sub
VB
  • ポイント:
    • ワイルドカード: 「文字」で部分一致。表示基準でサッと抽出。

外部ログ（txt/CSV）を読み込み＆検索

1) テキストログ（txt）を1行ずつ読み込み→抽出

Sub Log_ReadTxt_Extract()
    Dim p As String: p = ThisWorkbook.Path & "\app.log"
    If Dir(p) = "" Then MsgBox "ログがありません": Exit Sub

    Dim fn As Integer: fn = FreeFile
    Dim line As String, outRow As Long: outRow = 2
    Open p For Input As #fn
    Do Until EOF(fn)
        Line Input #fn, line
        If InStr(1, line, "ERROR", vbTextCompare) > 0 Then
            Worksheets("抽出").Cells(outRow, 1).Value = line
            outRow = outRow + 1
        End If
    Loop
    Close #fn
End Sub
VB
  • ポイント:
    • Line Input: 1行単位で確実に読める。部分一致・正規表現判定を挿入しやすい。

2) CSVログを列保持で取り込み→列条件で検索（QueryTables）

Sub Log_ReadCsv_QueryTables()
    With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & ThisWorkbook.Path & "\log.csv", Destination:=Range("A1"))
        .TextFileCommaDelimiter = True
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .Refresh BackgroundQuery:=False
    End With

    '例: レベル列(B)がERROR/WARNだけ抽出
    With Range("A1").CurrentRegion
        .AutoFilter Field:=2, Criteria1:=Array("ERROR", "WARN"), Operator:=xlFilterValues
    End With
End Sub
VB
  • ポイント:
    • 列構造を維持: レベルや日付列で絞れる。文字化けがある場合は事前に変換が必要。

3) 正規表現でパターン抽出（日時・IDを抜く）

Sub Log_ReadTxt_RegExp()
    Dim p As String: p = ThisWorkbook.Path & "\app.log"
    If Dir(p) = "" Then MsgBox "ログがありません": Exit Sub

    Dim re As Object: Set re = CreateObject("VBScript.RegExp")
    re.Pattern = "(\d{4}-\d{2}-\d{2} \d{2}:\d{2}:\d{2}).*\b(ERROR|WARN|INFO)\b.*ID=(\d+)"
    re.Global = False: re.IgnoreCase = True

    Dim fn As Integer: fn = FreeFile
    Dim line As String, m As Object, outRow As Long: outRow = 2
    Open p For Input As #fn
    Do Until EOF(fn)
        Line Input #fn, line
        Set m = re.Execute(line)
        If m.Count > 0 Then
            Worksheets("抽出").Cells(outRow, 1).Value = m(0).SubMatches(0) '日時
            Worksheets("抽出").Cells(outRow, 2).Value = m(0).SubMatches(1) 'レベル
            Worksheets("抽出").Cells(outRow, 3).Value = m(0).SubMatches(2) 'ID
            outRow = outRow + 1
        End If
    Loop
    Close #fn
End Sub
VB
  • ポイント:
    • キャプチャ: SubMatchesで括弧内グループを取り出す。複雑なパターンに強い。

期間・レベル別・複数ファイルの検索テンプレ

1) 期間で絞る（「YYYY-MM-DD HH:MM:SS」をDateSerialで検証）

Sub Log_FilterByTime()
    Dim p As String: p = ThisWorkbook.Path & "\app.log"
    If Dir(p) = "" Then MsgBox "ログがありません": Exit Sub

    Dim startT As Date, endT As Date
    startT = CDate("2025/01/01 00:00:00")
    endT = CDate("2025/01/31 23:59:59")

    Dim re As Object: Set re = CreateObject("VBScript.RegExp")
    re.Pattern = "(\d{4})-(\d{2})-(\d{2}) (\d{2}):(\d{2}):(\d{2})\s+(ERROR|WARN|INFO)"
    re.Global = False

    Dim fn As Integer: fn = FreeFile
    Dim line As String, ms As Object, outRow As Long: outRow = 2
    Open p For Input As #fn
    Do Until EOF(fn)
        Line Input #fn, line
        Set ms = re.Execute(line)
        If ms.Count > 0 Then
            Dim y As Integer, m As Integer, d As Integer, hh As Integer, mm As Integer, ss As Integer, t As Date
            y = CInt(ms(0).SubMatches(0)): m = CInt(ms(0).SubMatches(1)): d = CInt(ms(0).SubMatches(2))
            hh = CInt(ms(0).SubMatches(3)): mm = CInt(ms(0).SubMatches(4)): ss = CInt(ms(0).SubMatches(5))
            On Error Resume Next
            t = CDate(DateSerial(y, m, d) & " " & hh & ":" & mm & ":" & ss)
            On Error GoTo 0
            If t >= startT And t <= endT Then
                Worksheets("抽出").Cells(outRow, 1).Value = t
                Worksheets("抽出").Cells(outRow, 2).Value = ms(0).SubMatches(6) 'レベル
                Worksheets("抽出").Cells(outRow, 3).Value = line
                outRow = outRow + 1
            End If
        End If
    Loop
    Close #fn
End Sub
VB

2) レベル別にカウント（辞書で頻度集計）

Sub Log_CountByLevel()
    Dim p As String: p = ThisWorkbook.Path & "\app.log"
    If Dir(p) = "" Then MsgBox "ログがありません": Exit Sub

    Dim dict As Object: Set dict = CreateObject("Scripting.Dictionary")
    dict("ERROR") = 0: dict("WARN") = 0: dict("INFO") = 0

    Dim fn As Integer: fn = FreeFile, line As String
    Open p For Input As #fn
    Do Until EOF(fn)
        Line Input #fn, line
        If InStr(1, line, "ERROR", vbTextCompare) > 0 Then dict("ERROR") = dict("ERROR") + 1 _
        ElseIf InStr(1, line, "WARN", vbTextCompare) > 0 Then dict("WARN") = dict("WARN") + 1 _
        ElseIf InStr(1, line, "INFO", vbTextCompare) > 0 Then dict("INFO") = dict("INFO") + 1
    Loop
    Close #fn

    Range("E2").Value = "ERROR": Range("F2").Value = dict("ERROR")
    Range("E3").Value = "WARN":  Range("F3").Value = dict("WARN")
    Range("E4").Value = "INFO":  Range("F4").Value = dict("INFO")
End Sub
VB

3) 複数ログファイルをまとめて検索（フォルダ内ループ）

Sub Log_Search_MultiFiles()
    Dim dirPath As String: dirPath = ThisWorkbook.Path & "\Logs\"
    Dim name As String: name = Dir(dirPath & "*.log")
    Dim out As Worksheet: Set out = Worksheets("抽出")
    Dim outRow As Long: outRow = 2

    Do While name <> ""
        Dim fn As Integer: fn = FreeFile
        Dim line As String
        Open dirPath & name For Input As #fn
        Do Until EOF(fn)
            Line Input #fn, line
            If InStr(1, line, "ERROR", vbTextCompare) > 0 Then
                out.Cells(outRow, 1).Value = name
                out.Cells(outRow, 2).Value = line
                outRow = outRow + 1
            End If
        Loop
        Close #fn
        name = Dir()
    Loop
End Sub
VB

爆速のための安全・高速ラップ

Sub Log_SpeedWrapStart()
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.Calculation = xlCalculationManual
End Sub

Sub Log_SpeedWrapEnd()
    Application.Calculation = xlCalculationAutomatic
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub
VB
  • 使い方: 処理前後に挟むだけ。エラー時も復帰させるため On Error GoTo Cleanup でラップするのが安全。

よくある落とし穴と対策

  • 文字コードの違い（UTF-8の文字化け）
    • 対策: Excel標準のLine InputはShift_JIS前提。UTF-8なら事前変換が必要（ADODB.Streamを使う方法など）。CSVはQueryTablesで取り込みが比較的安定。
  • 巨大ファイルで遅い
    • 対策: まずキーワードで「絞り込みパス」（例：ERRORのみ）を実行、抽出後に詳細解析。配列化や辞書による集計でセルアクセスを減らす。
  • Findの設定保持で意図外検索
    • 対策: LookAt/LookIn/MatchCase/SearchOrderを毎回明示。Find→FindNextは1ループで完結。
  • 正規表現の過剰/過少一致
    • 対策: パターンは段階的にテスト。境界は \b が英数字中心のため、日本語の前後は空白・記号を明示する。
  • 期間抽出で不正日付が混入
    • 対策: DateSerial + On Errorでガードし、妥当なものだけ扱う。

例題で練習

'例1：シートA列の「WARN/ERROR」だけ抽出シートへ
Sub Example_SheetExtract()
    Dim last As Long, r As Long, s As String, outRow As Long
    last = Cells(Rows.Count, "A").End(xlUp).Row: outRow = 2
    For r = 2 To last
        s = CStr(Cells(r, "A").Value)
        If InStr(1, s, "WARN", vbTextCompare) > 0 Or InStr(1, s, "ERROR", vbTextCompare) > 0 Then
            Rows(r).Copy Destination:=Worksheets("抽出").Rows(outRow)
            outRow = outRow + 1
        End If
    Next
End Sub

'例2：txtログから「ID=数字」を正規表現で抽出して一覧化
Sub Example_TxtExtractIDs()
    Dim re As Object: Set re = CreateObject("VBScript.RegExp")
    re.Pattern = "ID=(\d+)": re.Global = False
    Dim p As String: p = ThisWorkbook.Path & "\app.log": If Dir(p) = "" Then Exit Sub

    Dim fn As Integer: fn = FreeFile, line As String, outRow As Long: outRow = 2
    Open p For Input As #fn
    Do Until EOF(fn)
        Line Input #fn, line
        Dim ms As Object: Set ms = re.Execute(line)
        If ms.Count > 0 Then
            Worksheets("抽出").Cells(outRow, 1).Value = CLng(ms(0).SubMatches(0))
            outRow = outRow + 1
        End If
    Loop
    Close #fn
End Sub

'例3：CSVログを列保持で読み込み、レベル=ERRORだけ抽出
Sub Example_CsvErrorExtract()
    With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & ThisWorkbook.Path & "\log.csv", Destination:=Range("A1"))
        .TextFileCommaDelimiter = True
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .Refresh BackgroundQuery:=False
    End With
    With Range("A1").CurrentRegion
        .AutoFilter Field:=2, Criteria1:="ERROR"
        .SpecialCells(xlCellTypeVisible).Copy Worksheets("抽出").Range("A1")
        .AutoFilter
    End With
End Sub
VB
スポンサーリンク
タイトルとURLをコピーしました