excel实现正则一一匹配功能

Function RegExpTest(patrn, col, tocol)
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