Excel/VBAで正規表現検索するラップ関数

VBAでの正規表現ラップ関数

VBAで正規表現を使う場合はVBScript.RegExpオブジェクトを呼び出すのが常套らしいですが、くっそ使いづらいのでラップ関数を作りました。

'  String(n)を返す。n = 0 にはマッチした文字列全体、n >= 1 にはExpressionの"()"内にマッチした文字列が入る。
'  マッチしない場合は String(0) = vbNullString を返す。
'  GlobalMatch = True で呼び出した後、引数を与えずに呼び出すと、2つ目以降のMatchDataを順に返す。
Function RegMatchStrings(Optional Expression As String, Optional SearchTarget As String, Optional GlobalMatch As Boolean = False) As String()

    Dim objRawRegExp As Object
    Dim ret() As String

    Static matches As Object
    Dim match As Object
    Dim submatches As Object

    Static mi As Long
    Dim i As Long

    If Expression = vbNullString And SearchTarget = vbNullString Then
        mi = mi + 1
        If Not matches Is Nothing Then
            If mi > matches.Count - 1 Then Set matches = Nothing
        End If
    Else
        Set objRawRegExp = CreateObject("VBScript.RegExp")
        objRawRegExp.Global = GlobalMatch
        objRawRegExp.Pattern = Expression
        If objRawRegExp.Test(SearchTarget) Then
            Set matches = objRawRegExp.Execute(SearchTarget)
        Else
            Set matches = Nothing
        End If
        mi = 0
    End If

    If Not matches Is Nothing Then
        Set match = matches(mi)

        ReDim ret(0 To match.submatches.Count)
        ret(0) = match

        If match.submatches.Count > 0 Then
            For i = 0 To match.submatches.Count - 1
                ret(1 + i) = match.submatches(i)
            Next i
        End If
    Else
        ReDim ret(0 To 0)
        ret(0) = vbNullString
    End If

    RegMatchStrings = ret
End Function

こんな感じで使えます。

sample

Sub Test()
    Dim rms() As String
    Dim s As Variant
    rms = RegMatchStrings("(\w*)-(\d{8})\.jpe?g", "image-20140227.jpeg, picture-20140228.jpg", True)
    Do While rms(0) <> vbNullString
        For Each s In rms
            Debug.Print s
        Next s
        rms = RegMatchStrings
    Loop
End Sub

result

image-20140227.jpeg
image
20140227
picture-20140228.jpg
picture
20140228

結果が全てStringで返ってくるので、RegExp.TestとかIS Nothingとかで調べなくていいのが楽だと思います。

Excel関数で正規表現検索

上記のラップ関数はそのままExcelのワークシート関数として呼び出しても使えますが、流石に使いづらいので更にラップで包みます。

' for EXCEL Worksheet Function
'
' マッチしたセルの相対的な位置を返す。
Function REGMATCH(Expression As String, SearchRange As Range) As Variant
    Application.Volatile
    Dim Cell As Range
    Dim i As Long

    REGMATCH = CVErr(xlErrNA)
    i = 1
    For Each Cell In SearchRange
        If RegMatchStrings(Expression, Cell.value, False)(0) <> vbNullString Then
            REGMATCH = i
            Exit For
        End If
        i = i + 1
    Next
End Function

' for EXCEL Worksheet Function
'
' マッチした文字列の配列を返す。
' MatchIndexに値を渡すと、対応した部分文字列を返す。
' マッチしない場合は #VALUE! エラーを、MatchIndexが範囲外の場合は #N/A! エラーを返す。
Function REGSEARCH(Expression As String, SearchTarget As String, Optional MatchIndex As Long = 0) As Variant
    Application.Volatile
    Dim rms() As String

    rms = RegMatchStrings(Expression, SearchTarget)
    If rms(0) <> vbNullString Then
        If MatchIndex = 0 Then
            REGSEARCH = rms
        Else
            If MatchIndex <= UBound(rms) Then
                REGSEARCH = rms(MatchIndex)
            Else
                REGSEARCH = CVErr(xlErrNA)
            End If
        End If
    Else
        REGSEARCH = CVErr(xlErrValue)
    End If
End Function

それぞれ、Excel関数のMATCH()、SEARCH()に挙動を合わせています。
ただし、SEARCH()はヒットした文字列の位置を返しますが、REGSEARCH()はヒットした文字列のそのものを返すようにしています。

---

正規表現検索するだけでこんな糞長いコード書かなければいけないのでExcel VBAは糞だと思いました。