一个可以使用多个正则表达式进行多次尝试匹配，并进行替换的Excel VBA自定义函数(UFD)

Posted 2020-10-05 hejing195

一个可以使用多个正则表达式进行多次尝试匹配、并根据不同的规则进行替换或提取的Excel VBA自定义函数(UFD)

该自定义函数可使用多个正则表达式对目标单元格进行多次匹配尝试，如匹配成功，将停止尝试匹配其他正则表达式，并且使用该正则表达式相对应的替换表达式进行替换，返回替换结果。

您可以直接下载包含该函数代码的XLSM文件，打开并启用宏之后，就可以直接使用该函数：http://url.cn/5WVPvgT

使用方法为：

Text参数：需要进行处理的原始文字或单元格。

MatchPatternRange参数：正则表达式组所在的单元格范围。请将多个正则表达式存放在表格中的一行或一列内，作为MatchPatternRange参数传入。

ReplacePattern参数：每个正则表达式相对应的替换字串符所在的单元格范围。请将用来作替换的文字放在正则表达式隔壁的行或列内，作为ReplacePatternRange参数传入。

IgnoreCase参数：在查找时是否忽略大小写，默认值为True，即忽略大小写区别。

 

如需在输入函数时获取参数提示，可以按Shift+F3，打开插入函数对话框，并在函数类别(category)中找到用户自定义(User Defined)，在下方文本框中找到RangeRegexReplace，再点击OK，就会弹出参数输入辅助界面。

 

 

如果您想学习一下如何自己插入VBA源代码，可以按照以下方法将下文中的VBA代码插入Excel工作簿：

先在Excel中按Alt+F11，进入VBE编辑器。然后在左侧找到需要插入代码的工作簿(Workbook)的名称。如果VBE编辑器左侧看不到这一块Project小窗口，可以试试看按Ctrl+R。

在下图中，我希望在工作簿Book1中插入代码，所以就选中了VBAProject (Book1)这一层。

右键单击该工作簿名称，依次点击Insert -- Module。

这时VBE左侧就会多出一个Module1，双击该Module1，在右侧代码输入界面中，将本文下面的代码复制粘贴进去。

 

本自定义函数由于使用了第三方库，使用前需要做Early Binding：即在VBE编辑器中，选择菜单栏中的Tool — Reference：

弹出如下图的对话框后，选择Microsoft VBSscript Regular Expression 5.5，打钩，点OK。

 

最后按Ctrl+S保存文件，注意在保存对话框中，文件类型需要选择“Excel启动宏的工作簿(*.xlsm)”，如下图

Function RangeRegexReplace(ByVal Text As String, ByVal MatchPatternRange As Range, _
    ByVal ReplacePatternRange As Range, Optional ByVal IngoreCase As Boolean = True) As String

\'By Jing He 2017-9-1
\'Last update 2017-9-2

Dim count As Integer, x As Integer, i As Integer, j As Integer
Dim pattern() As String, replace() As String

If MatchPatternRange.count <> ReplacePatternRange.count Then
    RangeRegexReplace = "Numbers of cells in MatchPatternRange and ReplacePatternRange are not equal."
    Exit Function
End If

count = MatchPatternRange.count
ReDim pattern(0 To count - 1) As String
ReDim replace(0 To count - 1) As String

i = 0
For Each c In MatchPatternRange
    pattern(i) = c.Value
    i = i + 1
Next c

j = 0
For Each c In ReplacePatternRange
    replace(j) = c.Value
    j = j + 1
Next c


\'Give no match value
RangeRegexReplace = "-"

Dim regex As New RegExp
With regex
    .Global = True
    .MultiLine = True
    .IgnoreCase = IngoreCase
End With

For x = 0 To count - 1 Step 1
    regex.pattern = pattern(x)
    If regex.Test(Text) Then
        RangeRegexReplace = regex.replace(Text, replace(x))
        Exit For
    End If
Next x

End Function

 

 顺便附带一个使用单个正则表达式进行查找替换的自定义函数，使用这个函数时，正则表达式可以直接写入公式的参数内，不需要放在单元格内再去引用。

Function RegexReplace(ByVal Text As String, ByVal MatchPattern As String, _
  ByVal ReplacePattern As String, Optional ByVal IngoreCase As Boolean = True) As String

\'By Jing He 2017-9-1

Dim regex As New RegExp

With regex
    .Global = True
    .MultiLine = True
    .IgnoreCase = IngoreCase
    .pattern = MatchPattern
End With

If regex.Test(Text) Then
    RegexReplace = regex.replace(Text, ReplacePattern)
Else
    RegexReplace = "-"
End If

End Function