如何确定VBA中Like比较模式的功能长度？解决编号提取问题

问题分析 #

核心矛盾是：VBA的Like模式字符串的字面长度和它实际匹配的**字符数（功能长度）**不统一。比如模式"[A-Z]"字面长度为5，但实际仅匹配1个大写字母；你使用的"#####[A-Z][A-Z]"字面长度是9，但实际要匹配7个字符（5位数字+2位大写字母），原代码用Len(Pattern)获取长度会导致遍历范围错误，无法捕获目标子串。

针对特定场景的快速修复 #

你的目标是提取5位数字+2位大写字母的报价单编号，模式的功能长度固定为7，直接修改代码中的长度赋值即可：

Function ExtractMatch(Source As String, Pattern As String) As String
' 提取符合指定模式的子串

    Dim i As Long, lenP As Long, Test As String
    lenP = 7 ' 固定功能长度，对应5个# + 2个[A-Z]的匹配长度
    ' 修正遍历范围，避免漏检最后一个可能的起始位置
    For i = 1 To Len(Source) - lenP + 1
        Test = Mid(Source, i, lenP)
        If Test Like Pattern Then
            ExtractMatch = Test
            Exit For
        End If
    Next
    
End Function

通用模式功能长度计算函数 #

如果需要适配更多固定长度的Like模式（不含*，因为*匹配任意长度字符，无固定功能长度），可以写一个解析函数自动计算功能长度：

Function GetPatternFunctionalLength(Pattern As String) As Long
    Dim i As Long, lenP As Long, functionalLen As Long
    lenP = Len(Pattern)
    functionalLen = 0
    i = 1
    
    Do While i <= lenP
        Select Case Mid(Pattern, i, 1)
            Case "[" ' 字符集，匹配1位字符
                functionalLen = functionalLen + 1
                ' 跳转到对应的闭合]
                i = InStr(i + 1, Pattern, "]")
                If i = 0 Then i = lenP ' 处理不闭合的[]，默认算1位
            Case "#", "?" ' 单个匹配符，各匹配1位字符
                functionalLen = functionalLen + 1
                i = i + 1
            Case "*" ' 可变长度匹配符，无固定长度，返回-1标记
                GetPatternFunctionalLength = -1
                Exit Function
            Case Else ' 普通字符，匹配自身1位
                functionalLen = functionalLen + 1
                i = i + 1
        End Select
    Loop
    
    GetPatternFunctionalLength = functionalLen
End Function

将此函数整合到你的提取函数中，即可适配多种固定长度模式：

Function ExtractMatch(Source As String, Pattern As String) As String
' 提取符合指定模式的子串

    Dim i As Long, lenP As Long, Test As String
    lenP = GetPatternFunctionalLength(Pattern)
    
    If lenP = -1 Then
        ExtractMatch = "模式包含*，无法计算固定长度"
        Exit Function
    End If
    
    If lenP = 0 Or lenP > Len(Source) Then
        ExtractMatch = ""
        Exit Function
    End If
    
    For i = 1 To Len(Source) - lenP + 1
        Test = Mid(Source, i, lenP)
        If Test Like Pattern Then
            ExtractMatch = Test
            Exit For
        End If
    Next
    
End Function

场景适配说明 #

修改后的函数会遍历源字符串的所有可能起始位置，无需依赖空格分隔，能解决手工录入文本中编号前后无空格的输入错误问题，直接捕获符合格式的报价单编号。

内容的提问来源于stack exchange，提问作者Andi Allan