Excel-在一个列中查找唯一值，在另一列中查找对应的值

您可以通过制作二维字典来做到这一点。我建议字典，因为它照顾到唯一性。我已经编写了一个执行任务的宏（至少在您的示例数据上）。它首先建立二维数据结构，然后按字母顺序打印出来。它包括我在这里找到的排序函数的简化版本：https : //exceloffthegrid.com/sorting-an-array-alphabetically-with-vba/

在我的宏中，数据是从第1行（For i = 1 To Cells(Row.Count...）读取到包含数据的最后一行。必要时进行调整。您可能还设置了正确的列字母（只需搜索ActiveSheet.Range就会看到）。

请注意，排序功能按字母顺序排序，因此标签11将在标签2之前。如果这是问题，我认为最快的方法是为标签数组创建第二个排序功能，该功能将标签转换为数字，然后进行比较。我知道，我知道这带来了糟糕的表现，但希望那没关系:)

首先，宏会读取所有输入行，并以，字符分隔（在空格之前删除-如果组件和标签始终由逗号和空格分隔，则可以简化）。对于每个组件，它都会创建一个子词典，标签将在其中存储并填充。如果某个组件多次出现，则现有字典将更新。这是第一个主要的For循环。如果设置了数据，它将打印出按列D和E排序的数据。这是“每个循环”的第二个主要内容。

最后是代码（我在工作簿部分中找到了它，而不是在工作表的代码模块中找到了它，但是也可以在其中工作）：

Sub CollectLabels()
    Dim spl() As String
    Dim dict
    Dim subDict
    Dim lbl As String

    ' Collect data into a 2-dimensional dictionary
    Set dict = CreateObject("Scripting.Dictionary")
    For i = 1 To Cells(Rows.Count, 1).End(xlUp).Row
        comps = Split(Replace(ActiveSheet.Range("A" & i).Text, " ", ""), ",")
        For Each comp In comps
            If Not dict.Exists(comp) Then
                Set subDict = CreateObject("Scripting.Dictionary")
                dict.Add comp, subDict
            End If
            Labels = Split(Replace(ActiveSheet.Range("B" & i).Text, " ", ""), ",")
            For Each Label In Labels
                dict(comp)(Label) = 1
            Next Label
        Next comp
    Next i

    i = 1
    ' Output the dictionary contents
    For Each Key In SortArray(dict.Keys)
        ActiveSheet.Range("D" & i).Value = Key
        lbl = ""
        For Each Key2 In SortArray(dict(Key).Keys)
            lbl = lbl & Key2 & ", "
        Next Key2
        ActiveSheet.Range("E" & i).Value = lbl
        i = i + 1
    Next Key
End Sub

Function SortArray(arr As Variant)

Dim i As Long
Dim j As Long
Dim Temp

For i = LBound(arr) To UBound(arr) - 1
    For j = i + 1 To UBound(arr)
        If arr(i) > arr(j) Then
            Temp = arr(j)
            arr(j) = arr(i)
            arr(i) = Temp
        End If
    Next j
Next i

SortArray = arr

End Function