VBA 从工作表 1 的 N 列中提取唯一列表，并根据工作表 1 上的条件在工作表 2 的 B 列上列出

Question

这里很棘手，因为我不是编码专家。

在第 1 页的 N 列上，我有一个产品列表 表1 D列有N列产品对应的供应商编号

第 2 页单元格 B1 有供应商编号。

我所追求的是一个vba代码，当从工作表2单元格B1的下拉列表中选择供应商编号时，该代码会自动运行，这是根据工作表1列中的供应商编号的匹配从工作表1列N生成的唯一列表D、放入B15。

Answer 1

• 使用

  Dictionary

  对象获取唯一的产品列表

Private Sub Worksheet_Change(ByVal Target As Range)
    With Target
        If .Address = "$B$1" And Len(.Cells(1).Value) > 0 Then
            Dim objDic As Object, rngData As Range
            Dim i As Long, sKey As String, sSupp As String
            Dim lastRow As Long, arrData
            Dim oSht1 As Worksheet
            Set oSht1 = Sheets("Sheet1")
            sSupp = .Value
            lastRow = oSht1.Cells(oSht1.Rows.Count, "N").End(xlUp).Row
            Set rngData = oSht1.Range("D1:N" & lastRow)
            arrData = rngData.Value
            Set objDic = CreateObject("scripting.dictionary")
            For i = LBound(arrData) To UBound(arrData)
                sKey = arrData(i, 11) ' Col N [Supplier]
                If StrComp(sSupp, sKey, vbTextCompare) = 0 Then
                    objDic(arrData(i, 1)) = ""
                End If
            Next i
            ' Write Product list to sheet
            lastRow = Me.Cells(Me.Rows.Count, "A").End(xlUp).Row
            Application.EnableEvents = False
            If lastRow > 14 Then Me.Range("A15:A" & lastRow).ClearContents
            If objDic.Count > 0 Then Me.Range("A15").Resize(objDic.Count, 1) = Application.Transpose(objDic.keys)
            Application.EnableEvents = True
        End If
    End With
End Sub