如何用Select Case替代嵌套字符串函数按物料号匹配图片名？

嘿，我看了你的代码和需求，发现几个小问题导致它没法适配可变长度的文件名，而且优先级里的「普通完全匹配图片」也没处理到。我重新写了代码，用Select Case实现，完美适配可变字符数的图片名，严格遵循你的三个优先级规则：

先说说原代码里的核心问题：

• 循环变量c的范围写错了，你写成了和r一样的行范围，应该遍历所有图片行（第三列的所有条目）
• 用固定长度的Left/Right截取，没法适配长度可变的物料号
• 缺少了优先级2的「完全匹配普通图片」的判断逻辑
• 默认图片的判断顺序可以更灵活，不用固定截取长度

修正后的代码 #

Option Explicit
Public Sub MatchMaterialImages()
    Dim ws As Worksheet
    Dim materialArr() As Variant
    Dim r As Long, imgRow As Long
    Dim materialNo As String
    Dim imgFileName As String, imgBaseName As String
    
    ' 设置目标工作表
    Set ws = ThisWorkbook.Worksheets("Sheet1")
    ' 读取A-C列数据到数组（A=物料号，B=匹配结果，C=图片名）
    materialArr = ws.Range("A2:C" & ws.Cells(ws.Rows.Count, "A").End(xlUp).Row).Value
    
    ' 遍历每个物料号
    For r = LBound(materialArr, 1) To UBound(materialArr, 1)
        materialNo = materialArr(r, 1)
        ' 遍历所有图片条目找匹配
        For imgRow = LBound(materialArr, 1) To UBound(materialArr, 1)
            imgFileName = materialArr(imgRow, 3)
            ' 提取不带扩展名的图片基础名（适配任意扩展名）
            imgBaseName = Left(imgFileName, InStrRev(imgFileName, ".") - 1)
            
            Select Case True
                ' 优先级1：物料号匹配，且文件名包含"ROOM"环境实拍图
                Case InStr(imgBaseName, materialNo) = 1 And InStr(imgBaseName, "ROOM") > 0
                    materialArr(r, 2) = imgFileName
                    Exit For '找到就退出图片循环，保留最高优先级
                
                ' 优先级2：物料号与图片基础名完全匹配的普通图片
                Case imgBaseName = materialNo
                    materialArr(r, 2) = imgFileName
                    Exit For
                
                ' 优先级3：按顺序匹配指定默认图片（-5 > -6 > -8）
                Case imgBaseName = materialNo & "-5"
                    materialArr(r, 2) = imgFileName
                Case imgBaseName = materialNo & "-6"
                    ' 只有当前未找到匹配时才赋值，保证顺序优先级
                    If materialArr(r, 2) = "" Then materialArr(r, 2) = imgFileName
                Case imgBaseName = materialNo & "-8"
                    If materialArr(r, 2) = "" Then materialArr(r, 2) = imgFileName
            End Select
        Next imgRow
    Next r
    
    ' 将匹配结果写回工作表
    ws.Range("A2").Resize(UBound(materialArr, 1), UBound(materialArr, 2)).Value = materialArr
End Sub

代码关键说明 #

1. 适配可变长度：用InStrRev提取不带扩展名的图片基础名，不管物料号或图片名长度如何变化都能正确识别
2. 优先级严格执行：
   • 找到优先级1的ROOM图直接退出循环，不再检查低优先级
   • 优先级2的完全匹配图同样找到就退出
   • 默认图片按-5 > -6 > -8的顺序赋值，只有前面的默认图没找到时才会赋值后面的
3. 循环逻辑修正：每个物料号独立遍历所有图片条目，确保不会遗漏任何匹配项

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