☰

Excel - 尋找一列中的唯一值和另一列中的對應值

tag-icon • tag-icon microsoft-excel worksheet-function vba sorting
Excel - 尋找一列中的唯一值和另一列中的對應值

我有兩列組件和標籤的資料庫匯出。 A 列包含元件，B 列包含與該元件關聯的標籤。同一元件可以在 A 列中多次顯示，但具有不同的標籤集。

我需要在儲存格 D 中建立一個唯一的元件列表，並在 E 列中元件旁邊的儲存格中列出每個關聯的標籤。

我知道如何在 A 列中建立唯一的值列表，但不知道如何在同一儲存格中出現多個值時分隔這些值。我無法更改資料庫匯出此數據的方式。

我對 VBA 有足夠的了解，可以為此創建一個宏，如果這是唯一的方法的話。任何幫助，將不勝感激。

這是我需要做的：

這是我需要做的

答案1

您可以透過製作二維字典來做到這一點。我建議使用字典，因為它可以保證唯一性。我已經編寫了一個執行該任務的巨集（至少在您的範例資料上）。它首先設定二維資料結構，然後按字母順序列印出來。它包括我在這裡找到的排序函數的簡化版本：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

相關內容