Excel多单元格数据匹配问询：含分隔符的字符串比对需求

1. 无需拆分分隔符的匹配方案（Excel 365） #

直接利用Excel 365的数组函数特性，无需拆分单元格即可判断B2内容是否是A2中用|分隔的项之一：

公式实现 #

=IF(COUNTIF(TEXTSPLIT(A2, "|"), B2)>=1, "Match", "No Match")

或更高效的精准匹配版本：

=IF(ISNUMBER(XMATCH(B2, TEXTSPLIT(A2, "|"))), "Match", "No Match")

说明：TEXTSPLIT将A2按|拆分为数组，COUNTIF/XMATCH检查B2是否在数组内。需确保已完成数据格式标准化（如日期统一为/分隔）。

VBA改进版（替代公式） #

修正你原有的InStr脚本，改为拆分A2为数组后精确匹配，避免子串误判：

Sub Exact_Match_With_Delimiter()
    Dim LastRow As Long, i As Long
    Dim aItems As Variant, bValue As String
    LastRow = Cells(Rows.Count, "A").End(xlUp).Row
    
    For i = 2 To LastRow
        bValue = Trim(Range("B" & i).Value2)
        aItems = Split(Range("A" & i).Value2, "|") ' 按|拆分A列内容为数组
        Range("C" & i).Value2 = "No Match"
        
        ' 遍历数组找精确匹配项
        For Each item In aItems
            If Trim(item) = bValue Then
                Range("C" & i).Value2 = "Match"
                Exit For
            End If
        Next item
    Next i
End Sub

2. 基于连续字符/数字的模糊匹配 #

针对SSN（连续7+字符）、邮编（连续5+数字）的场景，用正则表达式实现精准模糊匹配：

公式实现（Excel 365） #

SSN匹配（A2中包含B2的连续7+有效字符）

=IF(REGEXMATCH(A2, "\Q" & MID(REGEXREPLACE(B2, "[^0-9a-zA-Z]", ""), 1, 7) & "\E"), "Match", "No Match")

说明：先提取B2中的纯字符/数字，取前7位，再检查A2中是否包含该序列（\Q/\E避免正则特殊字符干扰）。

邮编匹配（A2中包含B2的连续5+数字）

=IF(REGEXMATCH(A2, "\Q" & REGEXEXTRACT(B2, "\d{5}") & "\E"), "Match", "No Match")

VBA正则实现（更灵活） #

Sub Fuzzy_Match_Regex()
    Dim LastRow As Long, i As Long
    Dim regEx As Object, aText As String, bText As String
    Set regEx = CreateObject("VBScript.RegExp")
    regEx.IgnoreCase = True
    LastRow = Cells(Rows.Count, "A").End(xlUp).Row
    
    For i = 2 To LastRow
        aText = Range("A" & i).Value2
        bText = Range("B" & i).Value2
        Range("C" & i).Value2 = "No Match"
        
        ' 匹配B2中连续7+字符在A2中存在（适配SSN）
        Dim cleanB As String
        cleanB = Replace(Replace(bText, "-", ""), "/", "") ' 清理特殊符号
        regEx.Pattern = "\Q" & Left(cleanB, 7) & "\E"
        If regEx.Test(aText) Then
            Range("C" & i).Value2 = "Match"
            GoTo NextRow
        End If
        
        ' 匹配B2中连续5+数字在A2中存在（适配邮编）
        regEx.Pattern = "\d{5}"
        Dim matches As Object
        Set matches = regEx.Execute(bText)
        If matches.Count > 0 Then
            regEx.Pattern = "\Q" & matches(0).Value & "\E"
            If regEx.Test(aText) Then Range("C" & i).Value2 = "Match"
        End If
NextRow:
    Next i
    Set regEx = Nothing
End Sub

3. 动态拆分列并保证VBA引用正常 #

如果必须拆分列，通过VBA动态计算最大分隔符数量，新增对应列后拆分，后续用动态列引用避免硬编码：

Sub Dynamic_Split_And_Match()
    Dim LastRow As Long, maxDelimiters As Integer, i As Long, j As Long
    Dim nextCol As Integer, matchCol As Integer
    
    ' 1. 计算A/B列中最大的|数量
    maxDelimiters = 0
    LastRow = Cells(Rows.Count, "A").End(xlUp).Row
    For i = 2 To LastRow
        maxDelimiters = Application.Max(maxDelimiters, _
            Len(Range("A" & i)) - Len(Replace(Range("A" & i), "|", "")), _
            Len(Range("B" & i)) - Len(Replace(Range("B" & i), "|", "")))
    Next i
    
    ' 2. 在现有数据列后新增所需列
    nextCol = Cells(1, Columns.Count).End(xlToLeft).Column + 1
    Columns(nextCol).Resize(, maxDelimiters).Insert Shift:=xlToRight
    
    ' 3. 拆分A列到新增列
    Range("A2:A" & LastRow).TextToColumns Destination:=Cells(2, nextCol), _
        DataType:=xlDelimited, Other:=True, OtherChar:="|"
    
    ' 4. 后续VBA用动态列引用写匹配结果
    matchCol = nextCol + maxDelimiters
    For i = 2 To LastRow
        Dim matchFound As Boolean
        matchFound = False
        ' 遍历拆分后的A列子项与B列比对
        For j = nextCol To nextCol + maxDelimiters - 1
            If Trim(Cells(i, j).Value2) = Trim(Range("B" & i).Value2) Then
                matchFound = True
                Exit For
            End If
        Next j
        Cells(i, matchCol).Value2 = IIf(matchFound, "Match", "No Match")
    Next i
End Sub

说明：

• 用maxDelimiters动态获取需拆分的最大列数，避免固定列数限制
• 所有列引用用列号（而非字母），后续VBA步骤通过变量动态定位，不受新增列影响

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