VBA Excel - 包含2个关键字段的DropDown列表

Question

我一直在努力解决这个问题。

我有2张Excel表格如下： Sheet 1中

Sheet 2中：

要求是根据来自Sheet1的MAT字段和工厂字段的Key值将Batch lis放入下拉列表中。

我已经使用额外的列＆＃34; KEY＆＃34;来完成它，其中我使用merge来表示两个字段的值＆＃34; MAT＆＃34;和＆＃34;植物＆＃34;并使用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