Dim regex, myrange, i, c, matches, match, str ' 建立变量。
Set regex = CreateObject("vbscript.regexp") ' 建立正则表达式。
regex.Pattern = patrn ' 设置模式。
regex.IgnoreCase = True ' 设置不区分字符大小写。
regex.Global = True ' 设置全局可用性。
Set myrange = ActiveSheet.Range(col & ":" & tocol) '获取分析数据
For Each c In myrange
i = c.Row
Column = c.Column
If regex.Test(c.Value) Then
Set matches = regex.Execute(c.Value) ' 执行搜索。
If matches.Count >= 1 Then
Cells(i, Column + 1) = matches(0) '写入第一个值
End If
If matches.Count >= 2 Then
Cells(i, Column + 2) = matches(1) '写入第二个值
End If
If matches.Count >= 3 Then
Cells(i, Column + 3) = matches(2) '写入第三个值
End If
End If
Next
End Function
Private Sub CommandButton1_Click()
s1 = InputBox("输入你的正则表达式。注意,最多三次匹配,在你选择的列的右侧三列返回,请注意不要覆盖掉有用数据")
s2 = InputBox("输入匹配开始单元格,不能跨列,如B3,不区分大小写")
s3 = InputBox("输入匹配结束单元格,不能跨列,如B20,不区分大小写")
Call RegExpTest(s1, s2, s3)
End Sub
Sub Test()
atr = Range("a65536").End(xlUp).Row
btr = Range("b65536").End(xlUp).Row
a = Range("a1:a" & atr).Value
b = Range("b1:b" & btr).Value
ReDim c(1 To atr, 1 To 1)
Set reg = CreateObject("vbscript.regexp")
With reg
.Global = True
.IgnoreCase = True
For ar = 1 To atr
For br = 1 To btr
.Pattern = b(br, 1)
If .Test(a(ar, 1)) Then
c(ar, 1) = "匹配"
Exit For
End If
Next
Next
End With
Range("c1:c" & atr) = c
Set reg = Nothing
End Sub