给Excel 添加正则表达式regexp()函数

WPS

推出了正则表达式函数regex家族，非常好用，必须给其点赞。听说微软在最新版本的Office也要推出，但老版本Office用户就不能使用这个函数，好在用VBA可以自定义一个函数也可以实现的，此函数不仅将三种模式融合到了同一个函数中，同时还支持数组、单元格、文本等多种数据处理

'****************************************************************************
' 函数名称: REGEXP()
' 作用: 用于正则表达式匹配、替换、测试
' 参数: FindStr 进行匹配的字符串、数组或范围
'       MyPattern 正则表达式匹配规则
'       mode 操作模式，0表示执行匹配操作，1表示执行测试操作，2表示执行替换操作
'       ReplaceWith 为要替换匹配内容的字符串
'       n 表示匹配结果的第n个，当n=0时返回全部匹配结果
'       IgnoreCase 表示是否忽略大小写，默认为False
' 返回: 以数组的形式返回结果
' 作者: wmh163
' 日期: 20240622
' 修改:
'****************************************************************************
Public Function REGEXP(ByVal FindStr, ByVal myPattern, Optional ByVal mode As Integer = 0, Optional ByVal ReplaceWith As String, Optional ByVal n As Integer = 0, Optional ByVal IgnoreCase As Boolean = False)
    ' 声明变量
    Dim i As Long
    Dim RE As Object, allMatches As Object, aMatch As Object
    ' 创建正则表达式对象
    Set RE = CreateObject("vbscript.regexp")
    RE.IgnoreCase = IgnoreCase
    RE.Global = True
    Dim tempStr
    tempStr = FindStr
    ' 判断FindStr的类型
    If TypeName(tempStr) = "String" Then
        ' 如果FindStr为字符串类型
        If TypeName(myPattern) = "String" Then
            ' 如果MyPattern为字符串类型
            RE.Pattern = myPattern
            If mode = 0 Then
                ' 匹配模式
                Set allMatches = RE.Execute(FindStr)
                If allMatches.Count >= 1 Then
                    ' 如果匹配到至少一个结果
                    ReDim rslt(1 To 1, 1 To allMatches.Count)
                    For i = 1 To allMatches.Count
                        rslt(1, i) = allMatches(i - 1).Value
                    Next i
                    If n = 0 Then
                        REGEXP = rslt
                    End If
                    If n > 0 Then
                        REGEXP = rslt(1, n)
                    End If
                Else
                    ' 如果没有匹配到结果
                    REGEXP = CVErr(2042)
                End If
            ElseIf mode = 2 Then
                ' 替换模式
                REGEXP = RE.Replace(FindStr, ReplaceWith)
            ElseIf mode = 1 Then
                ' 测试模式
                REGEXP = RE.test(FindStr)
            End If
        ElseIf TypeName(myPattern) = "Variant()" Then
            ' 如果MyPattern为数组
            ReDim arr(1 To 1, 1 To UBound(myPattern))
            If mode = 0 Then
                ' 匹配模式
                For i = 1 To UBound(myPattern)
                    RE.Pattern = myPattern(i)
                    Set allMatches = RE.Execute(FindStr)
                    If allMatches.Count >= 1 Then
                        arr(1, i) = allMatches(0)
                    Else
                        arr(1, i) = CVErr(2042)
                    End If
                Next
            ElseIf mode = 2 Then
                ' 替换模式
                For i = 1 To UBound(myPattern)
                    RE.Pattern = myPattern(i)
                    arr(1, i) = RE.Replace(FindStr, ReplaceWith)
                Next
            ElseIf mode = 1 Then
                ' 测试模式
                For i = 1 To UBound(myPattern)
                    RE.Pattern = myPattern(i)
                    arr(1, i) = RE.test(FindStr)
                Next
            End If
            REGEXP = arr
        ElseIf TypeName(myPattern) = "Range" Then
            ' 如果MyPattern为范围
            brr = myPattern
            n = UBound(brr)
            ReDim arr(1 To 1, 1 To n)
            If mode = 0 Then
                ' 匹配模式
                For i = 1 To n
                    RE.Pattern = brr(i, 1)
                    Set allMatches = RE.Execute(FindStr)
                    If allMatches.Count >= 1 Then
                        arr(1, i) = allMatches(0)
                    Else
                        '未找到返回#N/A错误
                        arr(1, i) = CVErr(2042)
                    End If
                Next
            ElseIf mode = 2 Then
                ' 替换模式
                For i = 1 To n
                    RE.Pattern = brr(i, 1)
                    arr(1, i) = RE.Replace(FindStr, ReplaceWith)
                Next
            ElseIf mode = 1 Then
                ' 测试模式
                For i = 1 To n
                    RE.Pattern = brr(i, 1)
                    arr(1, i) = RE.test(FindStr)
                Next
            End If
            REGEXP = arr
        End If
    ElseIf TypeName(tempStr) = "Variant()" Then
        ' 如果FindStr为数组
        RE.Pattern = myPattern
        ReDim arr(1 To 1, 1 To UBound(tempStr))
        If mode = 0 Then
            ' 匹配模式
            For i = 1 To UBound(tempStr)
                Set allMatches = RE.Execute(tempStr(i, 1))
                If allMatches.Count >= 1 Then
                    arr(1, i) = allMatches(0)
                Else
                    arr(1, i) = CVErr(2042)
                End If
            Next
        ElseIf mode = 2 Then
            ' 替换模式
            For i = 1 To UBound(tempStr)
                arr(1, i) = RE.Replace(tempStr(i, 1), ReplaceWith)
            Next
        ElseIf mode = 1 Then
            ' 测试模式
            For i = 1 To UBound(tempStr)
                arr(1, i) = RE.test(tempStr(i, 1))
            Next
        End If
        REGEXP = arr
    End If
End Function