**
- 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