如何用VBA基于公共子串匹配两列数据并设置fallback机制？

需求回顾 #

• A列：物料编号
• C列：图片文件名
• B列填充规则：
  • 优先填充与物料编号完全一致的图片文件名
  • 若无完全匹配项，填充对应物料编号的fallback图片（后缀限定为-5.jpg、-4.jpg、4-ROOM.jpg、5-ROOM.jpg）

原代码问题分析 #

1. 未实现完全匹配优先的逻辑，仅处理了fallback场景
2. 内层循环索引逻辑错误，遍历维度不符合需求
3. fallback匹配逻辑存在边界漏洞，未覆盖所有指定后缀

修正后的VBA代码 #

Public Sub MatchMaterialImage()
    Dim ws As Worksheet
    Dim arrData() As Variant
    Dim r As Long, c As Long
    Dim isMatched As Boolean
    
    ' 指定目标工作表
    Set ws = ThisWorkbook.Worksheets("Sheet1")
    ' 读取A2到C列最后一行的数据到数组，提升处理效率
    arrData = ws.Range("A2:C" & ws.Cells(ws.Rows.Count, "C").End(xlUp).Row).Value
    
    ' 遍历每一行物料编号
    For r = LBound(arrData, 1) To UBound(arrData, 1)
        isMatched = False
        ' 1. 优先查找完全匹配的图片
        For c = LBound(arrData, 1) To UBound(arrData, 1)
            If arrData(c, 3) = arrData(r, 1) & ".jpg" Then
                arrData(r, 2) = arrData(c, 3)
                isMatched = True
                Exit For
            End If
        Next c
        
        ' 2. 若无完全匹配，查找fallback图片（按优先级顺序）
        If Not isMatched Then
            ' 按需求顺序检查fallback后缀
            Dim fallbackSuffixes As Variant
            fallbackSuffixes = Array("-5.jpg", "-4.jpg", "4-ROOM.jpg", "5-ROOM.jpg")
            
            For Each suffix In fallbackSuffixes
                For c = LBound(arrData, 1) To UBound(arrData, 1)
                    If arrData(c, 3) = arrData(r, 1) & suffix Then
                        arrData(r, 2) = arrData(c, 3)
                        isMatched = True
                        Exit For
                    End If
                Next c
                If isMatched Then Exit For
            Next suffix
        End If
    Next r
    
    ' 将处理后的数组写回工作表
    ws.Range("A2").Resize(UBound(arrData, 1), UBound(arrData, 2)).Value = arrData
End Sub

代码说明 #

1. 数组读取：一次性读取所有数据到数组，避免频繁操作工作表，大幅提升运行速度
2. 完全匹配优先：先遍历所有图片，找到与物料编号+.jpg完全一致的项后直接填充
3. Fallback匹配：按指定顺序检查后缀，找到第一个匹配的fallback图片就停止遍历，符合需求逻辑
4. 状态标记：用isMatched变量避免重复查找，进一步优化处理效率

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