VBA ファイルを読み込みと色付け

そして正規表現で特定の文字を色付けしたい

Sub ProcessFiles()
    Dim lastRow As Long
    Dim i As Long
    Dim fileName As String
    Dim filePath As String
    Dim fileContent As String
    Dim regex As Object
    Dim matches As Object
    Dim pattern1 As String
    Dim pattern2 As String
    Dim fileNum As Integer
    Dim line As String
    Dim fullPath As String
    
    ' アクティブシートを取得
    Dim ws As Worksheet
    Set ws = ActiveSheet
    
    ' 最後の行を取得
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    
    ' 正規表現のパターン
    pattern1 = "正規表現1" ' 1つ目の正規表現をここに記載
    pattern2 = "正規表現2" ' 2つ目の正規表現をここに記載
    
    ' 正規表現オブジェクトの作成
    Set regex = CreateObject("VBScript.RegExp")
    regex.Global = True
    
    ' 1行ずつ処理
    For i = 1 To lastRow
        fileName = ws.Cells(i, "A").Value ' A列の数字をファイル名として取得
        filePath = "C:\path\to\folder\" & fileName & ".txt" ' テキストファイルのパスを作成（適宜修正）
        
        ' ファイルが存在するか確認
        If Dir(filePath) <> "" Then
            ' ファイルを開いて内容を1行ずつ読み取る
            fileNum = FreeFile
            Open filePath For Input As fileNum
            
            Do While Not EOF(fileNum)
                Line Input #fileNum, line
                
                ' 1つ目の正規表現に一致するか確認
                regex.Pattern = pattern1
                If regex.Test(line) Then
                    ' 一致した場合、その行をAB列に記載
                    ws.Cells(i, "AB").Value = line
                    
                    ' 2つ目の正規表現に一致する部分を赤く塗る
                    regex.Pattern = pattern2
                    Set matches = regex.Execute(line)
                    
                    If matches.Count > 0 Then
                        Dim match As Object
                        For Each match In matches
                            ' マッチ部分を赤くする
                            ' テキストファイルの内容をシートに記載しているため、そのセルの該当部分を赤くする
                            Dim startIndex As Integer
                            startIndex = InStr(line, match.Value)
                            If startIndex > 0 Then
                                ws.Cells(i, "AB").Characters(startIndex, match.Length).Font.Color = RGB(255, 0, 0)
                            End If
                        Next match
                    End If
                    
                    ' 1つ目に該当したら次のファイルに進む（1行のみ取得）
                    Exit Do
                End If
            Loop
            
            ' ファイルを閉じる
            Close fileNum
        Else
            ' ファイルがない場合はスキップ
            ws.Cells(i, "AB").Value = "ファイルが見つかりません"
        End If
    Next i
    
    ' 終了メッセージ
    MsgBox "処理が完了しました。"
End Sub

Sub HighlightMatchesInActiveCell()
    Dim regex As Object
    Dim matches As Object
    Dim pattern2 As String
    Dim cellContent As String
    Dim match As Object
    Dim matchStart As Integer
    
    ' アクティブセルの内容を取得
    cellContent = ActiveCell.Value
    
    ' 2つ目の正規表現のパターンを設定
    pattern2 = "正規表現2" ' 2つ目の正規表現をここに記載
    
    ' 正規表現オブジェクトの作成
    Set regex = CreateObject("VBScript.RegExp")
    regex.Global = True
    
    ' 2つ目の正規表現に一致する部分を探す
    regex.Pattern = pattern2
    Set matches = regex.Execute(cellContent)
    
    ' 一致した部分があれば色をつける
    If matches.Count > 0 Then
        For Each match In matches
            ' 一致した部分の開始位置を取得
            matchStart = InStr(cellContent, match.Value)
            
            ' 一致した部分を赤くする
            If matchStart > 0 Then
                ActiveCell.Characters(matchStart, Len(match.Value)).Font.Color = RGB(255, 0, 0)
            End If
        Next match
    Else
        MsgBox "正規表現に一致する部分がありません。"
    End If
End Sub