VBAで正規表現を活用！RegExpの設定・使用例・注意点まとめ

Sub RegexMatches()
    Dim regEx As Object       '// 正規表現オブジェクト
    Dim matches As Object     '// Matchesコレクション
    Dim match As Object       '// Matchオブジェクト
    Dim testString As String  '// 検索対象文字列

    '// 正規表現オブジェクトの作成
    Set regEx = CreateObject("VBScript.RegExp")
    
    '// 検索対象文字列
    testString = "今日は2025年1月9日です。数字は123456です。"

    '// 正規表現の設定（サブマッチを含むパターン）
    regEx.Pattern = "(\d{4})年(\d{1,2})月(\d{1,2})日|\d+"  '//年、月、日をサブマッチとして取得し、それ以外の数字も一致させる
    regEx.Global = True        '// 全体検索を有効にする
    regEx.IgnoreCase = True    '// 大文字小文字を区別しない

    '// 正規表現の実行（一致部分を取得）
    Set matches = regEx.Execute(testString)

    '// 一致部分を確認（Matchesコレクションのカウント）
    MsgBox "一致した部分の数: " & matches.Count

    '// 各一致部分をループで確認
    For Each match In matches
        '// Matchオブジェクトのプロパティを取得
        MsgBox "一致した値: " & match.Value & vbCrLf & _
               "位置: " & match.FirstIndex & vbCrLf & _
               "長さ: " & match.Length

        '// サブマッチがある場合の確認（ループを使用）
        If match.SubMatches.Count > 0 Then
            Dim i As Long
            Dim subMatchResult As String
            subMatchResult = "サブマッチの詳細:" & vbCrLf
            For i = 0 To match.SubMatches.Count - 1
                subMatchResult = subMatchResult & _
                    "サブマッチ" & i + 1 & ": " & match.SubMatches(i) & vbCrLf
            Next i
            MsgBox subMatchResult
        End If
    Next
End Sub

Dim regEx As Object   '// 正規表現オブジェクトを格納する変数を宣言

Set regEx = CreateObject("VBScript.RegExp") '// 正規表現オブジェクトを作成

testString = "今日は2025年1月9日です。数字は123456です。"

regEx.Pattern = "(\d{4})年(\d{1,2})月(\d{1,2})日|\d+"
regEx.Global = True
regEx.IgnoreCase = True

'// 正規表現の実行（一致部分を取得）
Set matches = regEx.Execute(testString)

'// 一致部分を確認（Matchesコレクションのカウント）
MsgBox "一致した部分の数: " & matches.Count

'// 各一致部分をループで確認
For Each match In matches
    '// Matchオブジェクトのプロパティを取得
    MsgBox "一致した値: " & match.Value & vbCrLf & _
           "位置: " & match.FirstIndex & vbCrLf & _
           "長さ: " & match.Length

    '// サブマッチがある場合の確認（ループを使用）
    If match.SubMatches.Count > 0 Then
        Dim i As Long
        Dim subMatchResult As String
        subMatchResult = "サブマッチの詳細:" & vbCrLf
        For i = 0 To match.SubMatches.Count - 1
            subMatchResult = subMatchResult & _
                "サブマッチ" & i + 1 & ": " & match.SubMatches(i) & vbCrLf
        Next i
        MsgBox subMatchResult
    End If
Next

For Each match In matches
    MsgBox "一致した値: " & match.Value
Next

regEx.Global = True '// 全体検索を有効にする 

regEx.Global = False '// 最初の一致だけを取得

Sub RegexWithArray()
    Dim regEx As Object
    Dim dataArray As Variant
    Dim matches As Object
    Dim i As Long

    '// 正規表現オブジェクトの作成
    Set regEx = CreateObject("VBScript.RegExp")
    regEx.Pattern = "\d+"      '// 数字を検索
    regEx.Global = True        '// 全体検索を有効にする

    '// データを配列に読み込む（A列のデータを取得）
    dataArray = Sheet1.Range("A1:A10000").Value

    '// 配列をループで処理
    For i = 1 To UBound(dataArray, 1)
        If Not IsEmpty(dataArray(i, 1)) Then
            If regEx.Test(dataArray(i, 1)) Then
                '// 一致部分を取得
                Set matches = regEx.Execute(dataArray(i, 1))
                Debug.Print "セル A" & i & ": " & matches(0).Value
            End If
        End If
    Next i
End Sub

Sub RegexWithFilteredData()
    Dim regEx As Object
    Dim matches As Object
    Dim filteredRange As Range
    Dim cell As Range

    '// 正規表現オブジェクトの作成
    Set regEx = CreateObject("VBScript.RegExp")
    regEx.Pattern = "\d+"      '// 数字を検索
    regEx.Global = True        '// 全体検索を有効にする

    '// A列に数字を含む行をフィルタリング
    With Sheet1
        .AutoFilterMode = False '// 既存のフィルターを解除
        .Range("A1:A1000").AutoFilter Field:=1, Criteria1:="=*#*" '// 条件付きフィルターを適用（# は数字を表すプレースホルダー）
        On Error Resume Next
        Set filteredRange = .Range("A2:A1000").SpecialCells(xlCellTypeVisible) '// フィルタリング後の可視セルを取得
        On Error GoTo 0
    End With

    '// フィルタリング後の範囲を処理
    If Not filteredRange Is Nothing Then
        For Each cell In filteredRange
            If regEx.Test(cell.Value) Then
                MsgBox "一致: " & regEx.Execute(cell.Value)(0).Value
            End If
        Next cell
    End If

    '// フィルターを解除
    Sheet1.AutoFilterMode = False
End Sub

Sub RegexEscapeExample()
    Dim regEx As Object
    Dim testString As String
    
    '// 正規表現オブジェクトの作成
    Set regEx = CreateObject("VBScript.RegExp")
    regEx.Pattern = "\." '// ピリオドそのものを検索
    regEx.Global = True  '// 全体検索を有効にする
    
    '// 検索対象文字列
    testString = "abc.def"
    
    '// 一致部分を確認
    If regEx.Test(testString) Then
        MsgBox "ピリオドが見つかりました！"
    Else
        MsgBox "ピリオドは見つかりませんでした。"
    End If
End Sub

Sub ExtractDates()
    Dim regEx As Object
    Dim matches As Object
    Dim testString As String
    Dim match As Object

    '// 正規表現オブジェクトの作成
    Set regEx = CreateObject("VBScript.RegExp")
    
    '// 検索対象の文字列
    testString = "イベントの日程は2025/01/17と2025/02/20です。締切は2025/03/15です。"
    
    '// 正規表現パターンの設定（YYYY/MM/DD形式の日付を検索）
    regEx.Pattern = "\d{4}/\d{1,2}/\d{1,2}"
    regEx.Global = True    '// 全体検索を有効にする
    
    '// 正規表現の実行
    Set matches = regEx.Execute(testString)
    
    '// 一致部分をループで確認
    For Each match In matches
        Debug.Print "一致した日付: " & match.Value
    Next match
End Sub

Sub ExtractPhoneNumbers()
    Dim regEx As Object
    Dim matches As Object
    Dim cell As Range
    Dim ws As Worksheet
    Dim outputRow As Long

    '// ワークシートの設定
    Set ws = ThisWorkbook.Sheets(1) '// 対象のシートを指定

    '// 正規表現オブジェクトの作成
    Set regEx = CreateObject("VBScript.RegExp")
    regEx.Pattern = "^(080|090)-\d{4}-\d{4}$" '// 電話番号形式を検索
    regEx.Global = True '// 全体検索を有効にする

    '// 出力先の初期位置を指定
    outputRow = 2 '// B列の2行目から書き出し

    '// A2:A10の範囲をループ
    For Each cell In ws.Range("A2:A10")
        If Not IsEmpty(cell.Value) Then '// セルが空でない場合
            If regEx.Test(cell.Value) Then
                '// 一致した電話番号をB列に書き出し
                ws.Cells(outputRow, 2).Value = cell.Value
                outputRow = outputRow + 1 '// 次の行に進む
            End If
        End If
    Next cell
End Sub

Sub ChangeColorForMatchedText()
    Dim regEx As Object
    Dim matches As Object
    Dim match As Object
    Dim cell As Range
    Dim ws As Worksheet
    Dim startPos As Long
    Dim matchLength As Long

    '// ワークシートの設定
    Set ws = ThisWorkbook.Sheets(1) '// 処理対象のシートを指定

    '// 正規表現オブジェクトの作成
    Set regEx = CreateObject("VBScript.RegExp")
    regEx.Pattern = "(080)" '// 電話番号が「080」で始まる箇所を指定
    regEx.Global = True '// 全体検索を有効にする

    '// A2:A10の範囲をループ
    For Each cell In ws.Range("A2:A10")
        If Not IsEmpty(cell.Value) Then '// セルが空でない場合
            If regEx.Test(cell.Value) Then
                '// 一致部分を取得
                Set matches = regEx.Execute(cell.Value)

                '// 各一致部分を処理
                For Each match In matches
                    startPos = match.FirstIndex + 1 '// 一致部分の開始位置（1始まり）
                    matchLength = match.Length '// 一致部分の長さ

                    '// マッチした部分の文字色を変更
                    cell.Characters(startPos, matchLength).Font.Color = RGB(255, 0, 0) '// 赤色
                Next match
            End If
        End If
    Next cell
End Sub

Sub RegexTemplate()
    Dim regEx As Object
    Dim matches As Object
    Dim match As Object
    Dim targetRange As Range
    Dim cell As Range

    '// 正規表現オブジェクトの作成
    Set regEx = CreateObject("VBScript.RegExp")
    
    '// 正規表現の設定（パターンを自由に変更してください）
    regEx.Pattern = "\d+"          '// 数字を検索
    regEx.Global = True            '// 全体検索を有効にする
    regEx.IgnoreCase = True        '// 大文字小文字を区別しない

    '// 検索対象範囲の設定（必要に応じて変更してください）
    Set targetRange = ThisWorkbook.Sheets(1).Range("A2:A100")

    '// 各セルをループして正規表現を適用
    For Each cell In targetRange
        If Not IsEmpty(cell.Value) Then
            If regEx.Test(cell.Value) Then
                '// 一致部分を取得
                Set matches = regEx.Execute(cell.Value)

                '// 一致した内容をデバッグウィンドウに出力（必要に応じてカスタマイズ）
                For Each match In matches
                    Debug.Print "セル: " & cell.Address & " 一致部分: " & match.Value
                Next match
            End If
        End If
    Next cell

    '// 後処理（必要なら追記）
    Set regEx = Nothing
End Sub