VBA自定义正则表达式

一个正则表达式的自定义函数

使用方法：插入一个module，粘进去上面的代码，工具中引用"Microsoft VBScript Regular Expressions 5.5" 就OK了。

Order	Name	Representation
1	成组	( )
2	成群	? + * {m,n} {m, n}?
3	锚点	abc ^ $
4	或
5	取组	$0-$9
字符表:
abr	same as	meaning
\d	[0-9]	数字
\D	[ ^0-9]	非数字
\w	[a-zA-Z0-9_]	数字和字母
\W	[ ^a-zA-Z0-9_]	非数字字母
\s	[ \r\t\f]	空白
\S	[ ^ \r\t\f]	非空白
	[\n]	新行

几个例子:

=regex(“Peter Gordon: [email protected], 47”, “\w+@\w+.\w+”)

=regex(“Peter Gordon: [email protected], 47”, “\w+@\w+.\w+”, “$0”)

Results in: [email protected]

=regex(“Peter Gordon: [email protected], 47”, “^(.+): (.+), (\d+)$”, “E-Mail: $2, Name: $1”)

Results in: E-Mail: [email protected], Name: Peter Gordon

=regex(“Peter Gordon: [email protected], 47”, “^(.+): (.+), (\d+)$","$” & 1)

=regex(“Peter Gordon: [email protected], 47”, “^(.+): (.+), (\d+)$","$” & 2)

Results in: Peter Gordon [email protected] .

代码：

Function regex(strInput As String, matchPattern As String, Optional ByVal outputPattern As String = "$0") As Variant
    Dim inputRegexObj As New VBScript_RegExp_55.RegExp, outputRegexObj As New VBScript_RegExp_55.RegExp, outReplaceRegexObj As New VBScript_RegExp_55.RegExp
    Dim inputMatches As Object, replaceMatches As Object, replaceMatch As Object
    Dim replaceNumber As Integer

    With inputRegexObj
        .Global = True
        .MultiLine = True
        .IgnoreCase = False
        .Pattern = matchPattern
    End With
    With outputRegexObj
        .Global = True
        .MultiLine = True
        .IgnoreCase = False
        .Pattern = "\$(\d+)"
    End With
    With outReplaceRegexObj
        .Global = True
        .MultiLine = True
        .IgnoreCase = False
    End With

    Set inputMatches = inputRegexObj.Execute(strInput)
    If inputMatches.count = 0 Then
        regex = False
    Else
        Set replaceMatches = outputRegexObj.Execute(outputPattern)
        For Each replaceMatch In replaceMatches
            replaceNumber = replaceMatch.SubMatches(0)
            outReplaceRegexObj.Pattern = "\$" & replaceNumber

            If replaceNumber = 0 Then
                outputPattern = outReplaceRegexObj.Replace(outputPattern, inputMatches(0).Value)
            Else
                If replaceNumber > inputMatches(0).SubMatches.count Then
                    'regex = "A to high $ tag found. Largest allowed is $" & inputMatches(0).SubMatches.Count & "."
                    regex = CVErr(xlErrValue)
                    Exit Function
                Else
                    outputPattern = outReplaceRegexObj.Replace(outputPattern, inputMatches(0).SubMatches(replaceNumber - 1))
                End If
            End If
        Next
        regex = outputPattern
    End If
End Function