Excel自定义函数——正则表达式函数

正则表达式函数

语法：

通用正则函数，函数定义RegExp(字符串，正则表达式[，匹配模式[，替换值]])对单元格返回正则获取后的字符串数组

参数说明：

• 参数1、原始字符串（必须填）,可在表格中使用，仅适用单个单元格

• 参数2、正则表达式

  • 符合语法的正则表达式字符串（必须填），提取和判断模式支持单行或单列的单元格、支持常量数组(如：{1,2})。

• 参数3、匹配模式

  • 0-提取，返回提取的数组结果

  • 1-判断，返回True，False

  • 2-替换，返回替换后的结果

  • 省略参数时，默认值（0）

• 参数4、替换内容

  • 参数3值为（2-替换）时，此参数可用，$1代表第一个捕获组

  • 省略参数时，默认值（空文本）

Public Function RegExp(ByVal source_str$, ByVal pattern As Variant, Optional ByVal mode& = 0, Optional ByVal replace_str$ = "") As Variant
    '通用正则表达式函数，函数定义RegExp(字符串，正则表达式[，匹配模式[，替换值]])对单元格返回正则获取后的字符串数组
    '参数说明：
    '参数1、原始字符串（必须填）,可在表格中使用，仅适用单个单元格
    '参数2、正则表达式
    '       符合语法的正则表达式字符串（必须填），提取和判断模式支持单行或单列的单元格、支持常量数组(如：{1,2})。
    '参数3、匹配模式
    '       0-提取，返回提取的数组结果
    '       1-判断，返回True，False
    '       2-替换，返回替换后的结果
    '       省略参数时，默认值（0）
    '参数4、替换内容
    '       参数3值为（2-替换）时，此参数可用，$1代表第一个捕获组
    '       省略参数时，默认值（空文本）
    '
    '--------------------------------------------------------
    'On Error Resume Next
    Dim result As Variant, i&, num&, match As Variant
    With CreateObject("vbscript.RegExp") '正则表达式对象
        .Global = True
        Select Case mode
        Case 0
            If TypeName(pattern) = "String" Then
                .pattern = pattern
                Set match = .Execute(source_str)
                num = match.Count
                If num = 0 Then
                    result = CVErr(xlErrNA)
                Else
                    ReDim result(1 To num)
                    For i = 0 To num - 1
                        result(i + 1) = match(i).Value
                    Next
                End If
            ElseIf TypeName(pattern) = "Range" Then
                If pattern.Columns.Count = 1 And pattern.Rows.Count = 1 Then    '单个单元格
                    .pattern = pattern.Value
                    Set match = .Execute(source_str)
                    num = match.Count
                    If num = 0 Then
                        result = CVErr(xlErrNA)
                    Else
                        ReDim result(1 To num)
                        For i = 0 To num - 1
                            result(i + 1) = match(i).Value
                        Next
                    End If
                ElseIf pattern.Columns.Count = 1 And pattern.Rows.Count <> 1 Then   '单列单元格
                    pattern = pattern.Value
                    num = UBound(pattern, 1)
                    ReDim result(1 To num, 1 To 1)
                    For i = 0 To num - 1
                        .pattern = pattern(i + 1, 1)
                        Set match = .Execute(source_str)
                        If match.Count = 0 Then
                            result(i + 1, 1) = CVErr(xlErrNA)
                        Else
                            result(i + 1, 1) = match(0).Value
                        End If
                    Next
                ElseIf pattern.Rows.Count = 1 And pattern.Columns.Count <> 1 Then
                    pattern = pattern.Value
                    num = UBound(pattern, 2)
                    ReDim result(1 To num)
                    For i = 0 To num - 1
                        .pattern = pattern(1, i + 1)
                        Set match = .Execute(source_str)
                        If match.Count = 0 Then
                            result(i + 1) = CVErr(xlErrNA)
                        Else
                            result(i + 1) = match(0).Value
                        End If
                    Next
                End If
            Else
                num = UBound(pattern)
                ReDim result(1 To num)
                For i = 0 To num - 1
                    .pattern = pattern(i + 1)
                    Set match = .Execute(source_str)
                    If match.Count = 0 Then
                        result(i + 1) = CVErr(xlErrNA)
                    Else
                        result(i + 1) = match(0).Value
                    End If
                Next
            End If
        Case 1
            If TypeName(pattern) = "String" Then
                .pattern = pattern
                result = .test(source_str)
            ElseIf TypeName(pattern) = "Range" Then
                If pattern.Columns.Count = 1 And pattern.Rows.Count = 1 Then
                    .pattern = pattern.Value
                    result = .test(source_str)
                ElseIf pattern.Columns.Count = 1 And pattern.Rows.Count <> 1 Then
                    pattern = pattern.Value
                    num = UBound(pattern, 1)
                    ReDim result(1 To num, 1 To 1)
                    For i = 0 To num - 1
                        .pattern = pattern(i + 1, 1)
                        result(i + 1, 1) = .test(source_str)
                    Next
                ElseIf pattern.Rows.Count = 1 And pattern.Columns.Count <> 1 Then
                    pattern = pattern.Value
                    num = UBound(pattern, 2)
                    ReDim result(1 To num)
                    For i = 0 To num - 1
                        .pattern = pattern(1, i + 1)
                        result(i + 1) = .test(source_str)
                    Next
                End If
            Else
                num = UBound(pattern)
                ReDim result(1 To num)
                For i = 0 To num - 1
                    .pattern = pattern(i + 1)
                    result(i + 1) = .test(source_str)
                Next
            End If
        Case 2
            .pattern = pattern
            result = .Replace(source_str, replace_str)
        End Select
    End With
    RegExp = result
End Function

给自定义函数编写函数说明

Sub RegExpFunctionDescription()
    Application.MacroOptions _
    Macro:="RegExp", _
    Description:="这是一个自定义正则表达式函数，基于正则表达式，进行复杂文本的匹配、提取、替换，结果返回文本。" & vbCrLf & _
    "函数语法：" & vbCrLf & _
    "　　　　　RegExp(字符串, 正则表达式[, 匹配模式[, 替换值]])", _
    Category:="自定义函数", _
    ArgumentDescriptions:=Array( _
    "原始字符串（必须填），要用正则表达式匹配的文本，可在表格中使用，仅适用单个单元格。", _
    "符合语法的正则表达式字符串（必须填）。提取和判断模式支持单行或单列的单元格、支持常量数组（如：{1,2}）。", _
    "匹配模式（可选项），默认值为：0。参数可选值：0-提取，返回提取的数组结果，1-判断，返回True，False，2-替换，返回替换后的结果。", _
    "替换内容（可选项），默认值为：空文本。只有参数3值为（2-替换）时，此参数可用，""$1""代表第一个捕获组，""$&""代表所有捕获内容。" _
    )
End Sub