VBA: поиск пакета

Question

Я не уверен, что делать со следующей проблемой с VBA

1. У меня есть список пакетов. Каждый пакет представляет собой группу предметов и имеет уникальный идентификатор. Один и тот же элемент может присутствовать в нескольких упаковках.

2. Два пакета не могут быть идентичными.

Пример данных в Excel:

**PackageName    Item**
Package1       Item1
Package1       Item2
Package1       Item3
Package2       Item2
Package2       Item3

Мои данные на другом листе

**Items**
Item1
Item2
Item3

Код должен возвращать

PackageName as Package1

Если мой ввод

Item2
Item3

Это должно вернуть мне

PackageName as Package2

Я не уверен, как наиболее эффективно действовать с кодом VBA для этой проблемы.

Ценю несколько указателей

Привет

Заранее спасибо

Answer 1

Вы можете использовать Dictionary объект:

Sub Main()
    Dim packagesDict As Object
    Dim cell As Range

    Dim items As Variant
    With Worksheets("Input") 'reference "Input" sheet
        items = Join(Application.Transpose(.Range("A2", .Cells(.Rows.Count, 1).End(xlUp)).Value), " ") ' build wanted package items content string
    End With

    Set packagesDict = CreateObject("Scripting.Dictionary")
    With Worksheets("Sample Data") 'reference "Sample Data" sheet
        For Each cell In .Range("A2", .Cells(.Rows.Count, 1).End(xlUp)) ' loop through packages in referenced sheet column A cells from row 2 down to last not empty one
            packagesDict(cell.Value2) = packagesDict(cell.Value2) & cell.Offset(, 1).Value2 & " " ' update current package content
            If Trim(packagesDict(cell.Value2)) = items Then ' if current package content matches wanted package items content then you've found the one
                MsgBox "Found: " & cell.Value2
                Exit For
            End If
        Next
    End With

End Sub

просто замените строки "Input" и "Sample Data" на ваши действительные имена входных и типовых таблиц данных