Выборка из 1-й таблици по данным 2-й. Сохранение результата в 3-ю

[Alex.Q]

Здравствуйте, уважаемые специалисты.
Помогите, пожалуйста, со следующей задачей:

1) Есть 1-й лист, таблица - прайс лист с артикулами (столбец "С", уникальные) товаров и другой информацией.
2) Есть 2-й лист, таблица - в столбце "А" храниться некоторое число артикулов.
3) Необходимо произвести выборку строк товаров из первой таблицы по артикульным номерам из второй таблицы. Результат выборки (полные строки товаров) сохранить в 3-й таблице.

Товары - уникальны, артикульные номера - не повторяются.

Exell 2011 MacOs

Заранее, большое спасибо за помощь!

ПС, прошу прощения за опечатку в названии темы: "...таблицы..."

[IgorGO]

режим ссылок R1C1
на листе Art_numbers, в колонки с 2 по 9 формулу:

=ЕСЛИ(RC1="";"";ИНДЕКС(Price_list!C1:C9;ПОИСКПОЗ(Art_numbers!RC1;Price_list!C3;);СТОЛБЕЦ()))

это будет без листа РЕЗУЛЬТАТЫ

[Alex.Q]

Сообщение от IgorGO

режим ссылок R1C1
на листе Art_numbers, в колонки с 2 по 9 формулу:

=ЕСЛИ(RC1="";"";ИНДЕКС(Price_list!C1:C9;ПОИСКПОЗ(Art_numbers!RC1;Price_list!C3;);СТОЛБЕЦ()))

это будет без листа РЕЗУЛЬТАТЫ

Спасибо большое, Игорь!

Как промежуточный вариант очень пригодиться, но я хотел, в будущем, попробовать автоматизировать некоторую часть, и искал решение на VBA с выводом результатов в отдельный лист, именно что бы была полная копия строк товаров, так как в прайс возможно добавление новых полей (т.е., заведомо не известно, сколько полей будет, но поле артикула - есть обязательно).

Еще раз, благодарю за ответы и потраченное время!

[tae1980]

Сообщение от Alex.Q

Exell 2011 MacOs

Excel 2003 Windows

[Hugo121]

Чуть подправил другой код, комментарии не менял

Option Explicit

'Макросом -
'1.два диапазона в два массива
'2.создание массива для результатов
'3.один перебор 300 значений массива в словарь
'4.100 000 проверок массива на наличие в словаре и заполнение данными массива результата
'5.выгрузка результатов (тут нет предварительной очистки диапазона)

Sub compare()
    Dim a, b, c, x As Byte, iLastrow As Long, i As Long, ii As Long

    '1.
    With Sheet1    'используется кодовое имя
        iLastrow = .Cells(Rows.Count, 1).End(xlUp).Row
        a = Range(.[i1], .Range("A" & iLastrow)).Value
    End With

    With Sheet2    'используется кодовое имя
        iLastrow = .Cells(Rows.Count, 1).End(xlUp).Row
        b = Range(.[a1], .Range("A" & iLastrow)).Value
    End With

    '2.
    ReDim c(1 To UBound(b), 1 To 9)

    With CreateObject("Scripting.Dictionary")
    
        '3.
        For i = 1 To UBound(a)
            .Item(a(i, 3)) = i
        Next

        '4.
        For i = 1 To UBound(b)
            If .exists(b(i, 1)) Then
                ii = ii + 1
                For x = 1 To 9: c(ii, x) = a(.Item(b(i, 1)), x): Next
            End If
        Next
    End With

    '5.
    With Sheet3    'используется кодовое имя
        .[a1].Resize(ii, UBound(c, 2)) = c
        .Activate
    End With

End Sub

Для больших объёмов мой вариант шустрее раз так в 40-50.

[IgorGO]

Sub CopyData()
  Dim r1 As Long, r2 As Long, r3 As Long
  r3 = 2
  Sheets(3).Cells.ClearContents
  Sheets(1).Rows(1).Copy Sheets(3).Cells(1, 1)
  On Error Resume Next
  For r2 = 1 To Sheets(2).Cells(Rows.Count, 1).End(xlUp).Row
    r1 = WorksheetFunction.Match(Sheets(2).Cells(r2, 1), Sheets(1).Columns(3), 0)
    If Err.Number = 0 Then
      Sheets(1).Rows(r1).Copy Sheets(3).Cells(r3, 1)
      r3 = r3 + 1
    Else
      Err.Clear
      Sheets(2).Cells(r2, 2) = "Not found!!!"
    End If
  Next
  On Error GoTo 0
  MsgBox r3 - 2 & " items copied", vbOKOnly, "Congratulation!!!"
End Sub

[Alex.Q]

IgorGO, Hugo121, tae1980 спасибо большое за решения!