Excel - Suchen Sie eindeutige Werte in einer Spalte und entsprechende Werte aus einer anderen

Question

Ich habe einen Datenbankexport von Komponenten und Beschriftungen in zwei Spalten. Spalte A enthält eine Komponente und Spalte B enthält die mit der Komponente verknüpften Beschriftungen. Dieselbe Komponente kann in Spalte A mehrfach auftauchen, jedoch mit unterschiedlichen Beschriftungen.

Ich muss eine eindeutige Liste von Komponenten in Zelle D erstellen und alle zugehörigen Beschriftungen in der Zelle neben der Komponente in Spalte E auflisten.

Ich weiß, wie man in Spalte A eine eindeutige Werteliste erstellt, aber nicht, wie man die Werte trennt, wenn mehrere in derselben Zelle vorkommen. Ich kann nicht ändern, wie die Datenbank diese Daten exportiert.

Ich weiß genug über VBA, um ein Makro dafür zu erstellen, wenn das die einzige Möglichkeit ist. Für jede Hilfe wäre ich dankbar.

Folgendes muss ich tun:

Answer 1

Sie können dies tun, indem Sie ein zweidimensionales Wörterbuch erstellen. Ich habe ein Wörterbuch vorgeschlagen, weil es für Eindeutigkeit sorgt. Ich habe ein Makro geschrieben, das diese Aufgabe übernimmt (zumindest für Ihre Beispieldaten). Es richtet zuerst die zweidimensionale Datenstruktur ein und druckt sie dann alphabetisch sortiert aus. Es enthält eine vereinfachte Version einer Sortierfunktion, die ich hier gefunden habe:https://exceloffthegrid.com/ein-Array-alphabetisch-sortieren-mit-vba/

In meinem Makro werden die Daten von Zeile 1 ( For i = 1 To Cells(Row.Count...) bis zur letzten Zeile gelesen, die Daten enthält. Passen Sie sie bei Bedarf an. Möglicherweise haben Sie auch die richtigen Spaltenbuchstaben eingestellt (suchen Sie einfach nach ActiveSheet.Range und Sie werden es sehen).

Bitte beachten Sie, dass die Sortierfunktion alphabetisch sortiert, sodass Label 11 vor Label 2 kommt. Wenn das ein Problem ist, denke ich, dass der schnellste Weg darin besteht, eine zweite Sortierfunktion für das Label-Array zu erstellen, die die Labels vor dem Vergleich in Zahlen umwandelt. Ich weiß, ich weiß, dass dies eine schreckliche Leistung mit sich bringt, aber hoffentlich ist das kein Problem :)

Zuerst liest das Makro alle Eingabezeilen und teilt sie nach , Zeichen auf (Leerzeichen werden vorher entfernt – wenn Komponenten und Beschriftungen immer durch Komma und Leerzeichen getrennt sind, können Sie es vereinfachen). Für jede Komponente erstellt es ein Unterwörterbuch, in dem die Beschriftungen gespeichert sind, und füllt sie aus. Wenn eine Komponente mehrfach vorkommt, wird das vorhandene Wörterbuch aktualisiert. Dies ist die erste Haupt-For-Schleife. Wenn Daten eingerichtet sind, druckt es die Daten sortiert nach den Spalten D und E aus. Dies ist die zweite Haupt-For-Each-Schleife.

Zum Schluss noch der Code (bei mir steht er im Workbook-Bereich, nicht im Codemodul des Blattes, aber könnte dort auch funktionieren):

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