VBA Excel - DropDown список с 2 ключевыми полями

Question

Я некоторое время боролся с этим требованием.

У меня есть 2 листа Excel следующим образом: Лист1

Лист2:

Требуется получить список партий в раскрывающемся списке на основе значений ключа из поля MAT и поля завода из листа Sheet1.

Я сделал это с помощью дополнительного столбца «КЛЮЧ», где я использую слияние для значений для обоих полей «MAT» и «Завод» и использую проверку данных с помощью INDIRECT

Но я хочу сделать это без дополнительного столбца и без объединения значений ключа.

Answer 1

Попробуйте следующее.

Private Sub LoadData()
    Dim ws1 As Worksheet
    Dim ws2 As Worksheet
    Dim lLastRowSheet1 As Long, lLastRowSheet2 As Long, i As Long
    Dim TheCombination As String
    Dim TheBatch As String
    Dim TheOptions() As String

    Dim dict As Object
    Set dict = CreateObject("Scripting.Dictionary")

    Set ws1 = ThisWorkbook.Sheets("Sheet1")
    Set ws2 = ThisWorkbook.Sheets("Sheet2")
    lLastRowSheet1 = ws1.Cells(Rows.Count, 1).End(xlUp).Row
    lLastRowSheet2 = ws2.Cells(Rows.Count, 1).End(xlUp).Row

    'Add elements to dictionary
    For i = 2 To lLastRowSheet1
        TheCombination = ws1.Cells(i, 1).Value & ws1.Cells(i, 2).Value 'combine MAT and PLANT
        TheBatch = ws1.Cells(i, 3).Value

        If Not dict.Exists(TheCombination) Then 'If key does not exist, add it
            dict.Add TheCombination, TheBatch
        Else
            TheItems = Split(dict.Item(TheCombination), ",")
            If Not IsInArray(TheBatch, TheItems) Then
                dict.Item(TheCombination) = dict.Item(TheCombination) & "," & ws1.Cells(i, 3).Value 'Add Batch if not already added
            End If
        End If
    Next

    For i = 2 To lLastRowSheet2
        TheSheet2Combination = ws2.Cells(i, 1).Value & ws2.Cells(i, 2).Value
        TheOptions = Split(dict.Item(TheSheet2Combination), ",")
        With ws2.Cells(i, 3).Validation
            .Delete
            .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlEqual, Formula1:=Join(TheOptions, ",")
        End With
    Next
End Sub


Function IsInArray(stringToBeFound As String, arr As Variant) As Boolean
    IsInArray = (UBound(Filter(arr, stringToBeFound)) > -1)
End Function