VBAでの正規表現マッチングによる部分文字列抽出

概要

やりたいこと

VBAで正規表現マッチングをして、部分マッチ文字列を抽出する

本文

ポイントというかはまった箇所

• regex.Execute()の戻り値は、Matchesコレクション。
• Matchesに複数要素を入らせるには、Globalプロパティをtrueにする必要がある。
• Matchesの要素であるMatchは、\1,\2,,,ではなく、regex.pattern全体に一致するものが入っている。
• MatchはSubMatchesを保有しており、ここに\1,\2,,,の部分文字列が入っている

コードサンプル

いずれも、標準モジュールに貼りつけたらそのまま動くはずです

単純な正規表現で、複数マッチさせたやつ

Option Explicit

Sub regexSample1()
    
    Dim regex As Object
    Set regex = CreateObject("VBScript.RegExp")
    regex.pattern = "([0-9]{4}/[0-9]{2}/[0-9]{2}) (.+)"
    regex.Global = True ' matchesを複数取得したい場合には必要
    
    ' マッチ対象文字列
    Dim s As String
    s = "2019/01/03 晴れ" & vbLf & "2019/02/04 雨" & vbLf & "2019/03/05 かみなり"
    
    ' マッチ実施
    Dim matches As Variant
    Set matches = regex.Execute(s)
    
    ' 結果をログ出力
    Dim match As Variant
    For Each match In matches
        Debug.Print "日付:" & match.submatches(0) & ", 天気:" & match.submatches(1)
    Next match
    Debug.Print
End Sub

結果(イミディエイトウィンドウに出力)

日付:2019/01/03, 天気:晴れ
日付:2019/02/04, 天気:雨
日付:2019/03/05, 天気:かみなり

エスケープとかの入った複雑なやつ

Option Explicit

Sub regexSample2()
    
    ' サンプル用のブックとシートを作成
    Workbooks.Add
    Dim wb As Workbook, ws As Worksheet
    Set wb = ActiveWorkbook
    Set ws = ActiveSheet
    With ws.Cells
        .Font.Name = "ＭＳ ゴシック"
        .Font.Size = 9
        .NumberFormatLocal = "@"
    End With
    
    ' サンプル用シートにログを出力
    Call setLog(ws)
    
    ' 正規表現オブジェクトの作成
    Dim regex As Object
    Set regex = CreateObject("VBScript.RegExp")
    Dim p As String
    p = ""
    p = p & "^" ' 行開始
    p = p & "([^ ]+)" ' \1:IPaddress（最初の空白まで）
    p = p & "[^\]]+" ' タイムスタンプの手前まで。"]"には正規表現としてのエスケープ\が必要
    p = p & "\[" ' "["には正規表現としてのエスケープ\が必要
    p = p & "([0-9]{1,2})/([a-zA-Z]+)/([0-9]{4}):([0-9]{2}:[0-9]{2}:[0-9]{2}) *" ' \2:日 \3:月 \4:年 \5:時分秒
    p = p & "([^]]+)\] *" '  \6\タイムゾーン
    p = p & """([^ ]+) *" ' \7:メソッド名
    p = p & "([^ ]*) " '\8: アクセスパス
    p = p & "([^""]*)"" *" ' \9:HTTPバージョン (「"」にはVBA文字列としてのエスケープ「"」が必要）
    p = p & "([0-9]+) *" ' \10:ステータスコード
    p = p & "[0-9]+" ' \11:プロセス番号
    p = p & "$" ' 行おわり
    regex.Pattern = p
    
    ' 出力ログ1行(A列のセル1つ)ごとに処理する
    Dim wrIn As Range
    Set wrIn = ws.Range("A2")
    Do While wrIn.Value <> ""
        
        Dim matches As Variant ' デバッグするとIMatchCollection2型とかなんだけど、定義の仕方がわからないのでvariantでごまかす
        Set matches = regex.Execute(wrIn.Value) ' 正規表現マッチングの実行
        
        If matches.Count = 1 Then ' ログ1行に対して「行頭～行末」でマッチングしているので、結果countは0か1
            Dim match As Variant ' デバッグするとIMatch2型とかなんだけど、定義の仕方がわからないのでvariantでごまかす
            Set match = matches(0)
            Dim idxMatch As Long
            Dim wrOut As Range
            Set wrOut = wrIn.Offset(0, 1)
            ' マッチ結果の\1,\2,,,はsubmatchesに格納されている
            For idxMatch = 0 To match.submatches.Count - 1
                wrOut.Value = match.submatches(idxMatch)
                Set wrOut = wrOut.Offset(0, 1)
            Next idxMatch
        Else
            wrIn.Offset(0, 1).Value = "not matched."
        End If
    
        Set wrIn = wrIn.Offset(1, 0)
    Loop
    
    ' 出力結果を整形
    ws.Range(ws.Cells(1, 1), ws.Cells(1, ws.Cells.SpecialCells(xlCellTypeLastCell).Column)).Value = Array("log", "IP", "day", "month", "year", "time", "timezone", "method", "access path", "http ver", "status", "process")
    ws.Range("B2").Select
    ActiveWindow.FreezePanes = True
    ws.Cells(1, 1).EntireColumn.ColumnWidth = 3
    ws.Range(ws.Cells(1, 2), ws.Cells(1, ws.Cells.SpecialCells(xlCellTypeLastCell).Column)).EntireColumn.AutoFit
    
    MsgBox "done"
End Sub


' ワークシートにサンプルログを出力する
' ログはこちらから拝借
' https://httpd.apache.org/docs/2.2/ja/logs.html#accesslog
Private Function setLog(ws As Worksheet)
    Dim log As Variant
    
    log = Array( _
        "127.0.0.1 - frank [10/Oct/2000:13:55:36 -0700] ""GET /apache_pb.gif HTTP/1.0"" 200 2326" _
        , "127.0.0.1 - frank [1/Oct/2000:13:55:36 -0700] ""POST /apache_pb.gif?attr=value HTTP/1.0"" 200 2326" _
        )
    Dim wr As Range
    Set wr = ws.Range("A2") ' ログ出力開始セル
    Dim i As Long
    For i = LBound(log) To UBound(log)
        wr.Value = log(i)
        Set wr = wr.Offset(1, 0)
    Next i
End Function

結果(新規のExcelブックに出力)

参考

• Execute メソッド (VBScript) - MSDN - Microsoft
  -- https://docs.microsoft.com/ja-jp/previous-versions/windows/scripting/cc392389(v=msdn.10)
• SubMatches コレクション
  -- https://docs.microsoft.com/ja-jp/previous-versions/windows/scripting/cc392216%28v%3dmsdn.10%29