Как в Excel реализовать такой алгоритм?

Question

[Александр]

Есть много тысяч картинок. И есть большая Excel таблица с прайсом товаров. Название картинок = код товара. В Excel есть столбец "Код товара", там все эти коды заданы.
Пожалуйста, подскажите, как в Excel реализовать такой алгоритм:

1. Взять имя картинки;
   
2. Найти это имя в столбце "Код товара"
   
3. Если нашлось совпадение, вставить эту картинку в строку с совпадшим кодом товара
   

В итоге должна получится таблица, в которой картинки вставлены в строки, "код товара" в которых совпадает с названием картинок

Answer 1

[Антон Федорян]

Может логичнее наоборот, брать код из таблицы и проверять, существует ли картинка?

Sub Макрос1()
    Dim code, pic As Integer
    Dim i As Integer
    Dim path As String
    
     ' номер столбца с кодами товаров
    code = 3
     ' номер столбца для картинок
    pic = 4
     ' путь к папке с картинками
    path = "C:\Users\admin\Pictures\"
    
    i = 1
    While (Cells(i, code) <> "")
                            ' возможно нужно будет дописывать еще и расширение картинки
        If Len(Dir$(path & Str(Cells(i, code)))) > 0 Then
            InsertPicture Cells(i, pic), (path & Cells(i, code)), True, True, True
        End If
        i = i + 1
    Wend
End Sub

Sub InsertPicture(ByRef PicRange As Range, ByVal PicPath As String, _
                     Optional ByVal AdjustWidth As Boolean, _
                     Optional ByVal AdjustHeight As Boolean, _
                     Optional ByVal AdjustPicture As Boolean = False)

    On Error Resume Next: Application.ScreenUpdating = False

    Dim ph As Picture: Set ph = PicRange.Parent.Pictures.Insert(PicPath)

    ph.Top = PicRange.Top: ph.Left = PicRange.Left
 
    K_picture = ph.Width / ph.Height
    K_PicRange = PicRange.Width / PicRange.Height

    If AdjustPicture Then

        If AdjustWidth Then ph.Width = PicRange.Width: ph.Height = ph.Width / K_picture
 
        If AdjustHeight Then ph.Height = PicRange.Height: ph.Width = ph.Height * K_picture
 
        If AdjustWidth And AdjustHeight Then ph.Width = PicRange.Width: ph.Height = PicRange.Height
 
 
    Else

        If AdjustWidth Then
            PicRange.Cells(1).ColumnWidth = PicRange.Cells(1).ColumnWidth * ph.Width / PicRange.Cells(1).Width
            While Abs(PicRange.Cells(1).Width - ph.Width) > 0.1
                PicRange.Cells(1).ColumnWidth = PicRange.Cells(1).ColumnWidth - 0.2 * (PicRange.Cells(1).Width - ph.Width)
            Wend
        End If
 
        If AdjustHeight Then
            PicRange.Cells(1).RowHeight = PicRange.Cells(1).RowHeight * ph.Height / PicRange.Cells(1).Height
            While Abs(PicRange.Cells(1).Height - ph.Height) > 0.1
                PicRange.Cells(1).RowHeight = PicRange.Cells(1).RowHeight - 0.2 * (PicRange.Cells(1).Height - ph.Height)
            Wend
        End If
 
    End If
End Sub

Функция вставки взята отсюда.