Excel VBA实现Code列与Name列序列片段匹配并生成Match标记

嗨，作为VBA新手碰到这种匹配需求完全不用慌！我来一步步帮你实现这个功能：咱们要在Sheet1的Code列旁边新增一列叫Match，然后逐个检查Code列的每个单元格，和Name列的所有单元格比对——只要有任意一个Name单元格的内容是Code单元格的连续子串，或者Code单元格是Name单元格的连续子串，就标记yes，否则标记no，完全贴合你举的Wreakhavoc和Reak匹配的例子。

直接可用的VBA代码 #

Sub CheckContinuousMatch()
    Dim ws As Worksheet
    Dim lastRowCode As Long, lastRowName As Long
    Dim i As Long, j As Long
    Dim codeVal As String, nameVal As String
    Dim isMatch As Boolean
    
    ' 指定操作的工作表为Sheet1
    Set ws = ThisWorkbook.Worksheets("Sheet1")
    
    ' 在Code列旁新增Match列（假设Code在A列、Name在B列，Match放在C列）
    If ws.Range("C1").Value <> "Match" Then
        ws.Range("C1").Value = "Match"
        ws.Range("C1").Font.Bold = True
    End If
    
    ' 获取两列的最后一行行号，避免遍历空单元格
    lastRowCode = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    lastRowName = ws.Cells(ws.Rows.Count, "B").End(xlUp).Row
    
    ' 遍历Code列的每个数据行（跳过标题行）
    For i = 2 To lastRowCode
        codeVal = ws.Cells(i, "A").Value
        isMatch = False ' 默认设为不匹配
        
        ' 遍历Name列所有单元格，检查连续片段匹配
        For j = 2 To lastRowName
            nameVal = ws.Cells(j, "B").Value
            
            ' 双向检查：Code包含Name，或者Name包含Code，只要满足其一就算匹配
            ' vbTextCompare是不区分大小写，要区分的话改成vbBinaryCompare
            If InStr(1, codeVal, nameVal, vbTextCompare) > 0 Or _
               InStr(1, nameVal, codeVal, vbTextCompare) > 0 Then
                isMatch = True
                Exit For ' 找到匹配就停止遍历Name列，提升效率
            End If
        Next j
        
        ' 给Match列写入结果
        ws.Cells(i, "C").Value = IIf(isMatch, "yes", "no")
    Next i
    
    MsgBox "匹配检查完成！", vbInformation
End Sub

新手操作指南 #

1. 打开你的Excel文件，按下Alt + F11打开VBA编辑器；
2. 在左侧的「工程资源管理器」里，右键点击你的工作簿名称，选择「插入」→「模块」；
3. 把上面的代码粘贴到弹出的代码窗口里；
4. 按下F5键运行代码，或者点击编辑器顶部的运行按钮（绿色小三角）。

自定义调整提示 #

如果你的Code列和Name列不在A、B列，只需要修改代码里的列字母就行：比如Code在D列、Name在E列，就把代码里的"A"改成"D"，"B"改成"E"，Match列对应改成"F"（即ws.Range("F1")和ws.Cells(i, "F")）。

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