假设模式中没有*，我们可以使用以下函数获得模式的长度：

Function getPatterLength(ByVal Pattern As String) As Long
    If InStr(Pattern, "*") > 0 Then
        getPatterLength = -1
        Exit Function
    End If

    Dim Parts() As String
    Parts = Split(Pattern, "[")

    Dim i As Long
    For i = 0 To UBound(Parts)
        If InStr(Parts(i), "]") > 0 Then
            Parts(i) = Mid(Parts(i), InStr(Parts(i), "]"))
        End If
    Next

    getPatterLength = Len(Join(Parts, ""))
End Function

为模式长度向提取函数添加一个参数会更容易。

Function ExtractMatch(Source As String, Pattern As String, PatterLength as long) As String
' extracts a substring matching the given pattern

    Dim i As Long, Test As String
        For i = 1 To Len(Source) - PatterLength
            Test = Mid(Source, i, PatterLength)
            Debug.Print Test
            If Test Like Pattern Then
            ExtractMatch = Test
            Exit Function
        End If

        Exit For
    End If
    Next
    
End Function

您可以使用正则表达式来提取子匹配，如下所示：

Public Sub Example()
    Debug.Print ExtractSubstring("Quote number 11111AA refers", "[0-9]{5}[A-Z]{2}")
End Sub

Public Function ExtractSubstring(ByVal InputString As String, ByVal Pattern As String) As String
    Dim RetVal As String
    Dim AllMatches As Object
    Dim RegEx As Object
    Set RegEx = CreateObject("vbscript.regexp")
    
    With RegEx
        .Pattern = Pattern
        .Global = True
        .IgnoreCase = True  ' change this if you want case sensitivity
    End With
    Set AllMatches = RegEx.Execute(InputString)
    
    If AllMatches.Count <> 0 Then
        RetVal = AllMatches.Item(0)
    End If
    
    ExtractSubstring = RetVal
End Function

甚至可以像UDF（用户定义函数）一样直接使用它

=ExtractSubstring(A2,"[0-9]{5}[A-Z]{2}")

请注意，如果有更多的匹配项与此模式匹配，则只返回第一个匹配项。

我想看看是否可以通过FILTERXML()来实现这一点会很有趣（至少对一些人来说）：

B2中的公式：

=MAP(A2:A5,LAMBDA(x,FILTERXML("<t><s>"&TEXTJOIN("</s><s>",,MID(x,SEQUENCE(LEN(x)),7))&"</s></t>","//s[string-length(normalize-space())=7][substring(.,1,5)*0=0][translate(substring(.,6),'ABCDEFGHIJKLMNOPQRSTUVWXYZ','')=''][1]")))

解构的xpath anding predicate ：

• [string-length(normalize-space())=7]-我们需要测试节点的长度是否等于7个字符（标准化后：由于第三个同品种器械的工作，这一点很重要）。在正则表达式中：^.{7}$ ;
• [substring(.,1,5)*0=0]-测试节点的前5个字符是否为数字。在正则表达式中：^\d{5} ;
• [translate(substring(.,6),'ABCDEFGHIJKLMNOPQRSTUVWXYZ','')='']-Assert最后两个字符是大写字母字符。在正则表达式中：[A-Z]{2}$ ;
• [1]-从过滤后的节点列表中检索第一个节点。

为什么不使用正则表达式：

Public Sub test()

Dim pattern As String
pattern = "\d{5}[A-Z]{2}"

Debug.Print regex_PatternMatch(pattern, "11111AA")  'will return true
Debug.Print regex_PatternMatch(pattern, "111AA")   'will return false

End Sub

Public Function regex_PatternMatch(pattern As String, textToCheck As String) As Boolean
    Dim regEx As New RegExp
    With regEx
        .pattern = pattern
        regex_PatternMatch = .test(textToCheck)
    End With
End Function

必须添加对VB脚本正则表达式的引用