遍历图像列表,如果未找到则使用后备吗?

时间:2020-10-14 20:38:46

标签: excel vba

我在CSV文件中有两列-列A和C,前者包含项目编号,而后者图像可能具有或不具有相同的项目编号。 我希望匹配的图像在B列中相邻显示

根据尺寸,图像有几种不同的形式,首选是以“ -ROOM.jpg”结尾的图像,然后以“ -5.jpg”结尾的图像,然后是“ -6.jpg”。找不到第一种类型,我想使用条件语句返回到“ -5.jpg”然后是“ -6.jpg”。

以下是前几行的显示内容:

enter image description here

| SKU         |   | image                |
|-------------|---|----------------------|
| SHS211A-9   |   | SG140B-3.jpg         |
| SHS211A-8   |   | SG140E-4R-FLOOR2.jpg |
| SHS211A-6SQ |   | SG140E-5.jpg         |
| SHS211A-6   |   | SG140E-6R-FLOOR.jpg  |
| SHS211A-5   |   | SG140E-6R-ROOM.jpg   |
| SHS211A-3   |   | SG140E-8-ROOM.jpg    |
| SHS211A-28  |   | SG140E-8.jpg         |
| SHS211A-26  |   | SG140E-4R-FLOOR1.jpg |
| SHS211A-24  |   | SG140E-4R-FLOOR2.jpg |
| SHS211A-2   |   | SG140G-4R.jpg        |
| SHS211A     |   | SG140G-5-FLOOR.jpg   |

我已经尝试过了,但是它不检查图像类型(非常不熟悉VBA):

Sub Adrift()
    Dim NA As Long, NC As Long, v As String, I As Long, J As Long
    Dim v2 As String
    NA = Cells(Rows.Count, "A").End(xlUp).Row
    NC = Cells(Rows.Count, "C").End(xlUp).Row
    For I = 2 To NA
        v = Cells(I, "A").Value
        v2 = ""
        For J = 2 To NC
            If InStr(Cells(J, "C").Value, v) > 0 Then
                v2 = v2 & ";" & Cells(J, "C").Value
            End If
        Next J
        Cells(I, "A").Offset(0, 1).Value = Mid(v2,2)
    Next I
End Sub

1 个答案:

答案 0 :(得分:1)

类似以下内容的方法可能会起作用,在该方法中,我读入数组,然后循环行和最后一列,检查最后一列是否以当前外部行第1列中的内容开头,并以任何所需的字符串结尾。我不知道您是否要处理区分大小写和潜在的空格.....您可能可以重构一下以简化操作。

假定A和C的长度相同。如果C较长,则在arr = ws.Range("A2:C" & ws.Cells(ws.Rows.Count, "C").End(xlUp).Row)中使用“ C”。如果A较长,则按原样可以。

Option Explicit

Public Sub test()

    Dim ws As Worksheet, arr(), r As Long, c As Long

    Set ws = ThisWorkbook.Worksheets("Sheet1")

    arr = ws.Range("A2:C" & ws.Cells(ws.Rows.Count, "A").End(xlUp).Row)
    
    On Error Resume Next
    
    For r = LBound(arr, 1) To UBound(arr, 1)

        For c = LBound(arr, 1) To UBound(arr, 1)
 
            Select Case True

            Case Right$(arr(c, 3), 9) = "-ROOM.jpg" And Left$(arr(c, 3), Len(arr(c, 3)) - 9) = arr(r, 1)
                arr(r, 2) = arr(c, 3)
                Exit For
            Case Right$(arr(c, 3), 6) = "-5.jpg" And Left$(arr(c, 3), Len(arr(c, 3)) - 6) = arr(r, 1)
                arr(r, 2) = arr(c, 3)
                Exit For
            Case Right$(arr(c, 3), 6) = "-6.jpg" And Left$(arr(c, 3), Len(arr(c, 3)) - 6) = arr(r, 1)
                arr(r, 2) = arr(c, 3)
                Exit For

            End Select
   
        Next

    Next
    
    On Error GoTo 0
    
    ws.Range("A2").Resize(UBound(arr, 1), UBound(arr, 2)) = arr
End Sub