Zelleninhalte zusammenfassen wenn einer Größe zugeordnet

Hallo zusammen,

ich habe eine Excelliste. Wir bedrucken Textilien und erhalten von den Kunden oft Listen, bei denen wir die Aufdrucke, z. B. Initialen aktuell von Hand übernehmen. Ich möchte das mit Excel etwas vereinfachen.

Bsp.:
In Spalte A stehen unterschiedliche Textilgrößen, z. B. M, L und XL
In Spalte B ist der Größe eine Nummer zugeordnet die wir auf das Textil drucken müssen.

Zelle A2 = S
Zelle B2 = BR

Somit wissen wir, dass wir der Größe S die Initialen BR zuordnen müssen.

Ich habe jetzt 120 unterschiedliche Größen mit dazugehörigen Initialen.
In Excel möchte ich alle Initialen die einer Größe zugeordnet sind, in einer Zelle zusammenfassen.

Anbei meine Beispieldatei: https://www.herber.de/bbs/user/163942.xlsx

Danke für Eure Hilfe!

Grüße

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

let Quelle = Excel.CurrentWorkbook(){[Name="Tabelle1"]}[Content], Sortieren = Table.Sort(Quelle,{{"Initialen", Order.Ascending}, {"Größe", Order.Ascending}}), Duplikate_entfernt = Table.Distinct(Sortieren), Gruppiert = Table.Group(Duplikate_entfernt, {"Größe"}, {{"Alle", each Text.Combine([Initialen],", "), type text}}) in Gruppiert

Sub Mydic() Dim objD As Object Set objD = CreateObject("scripting.dictionary") For Z = 2 To Cells(2, 1).End(xlDown).Row If objD.exists(CStr(Cells(Z, 1))) Then objD(CStr(Cells(Z, 1))) = objD(CStr(Cells(Z, 1))) & ", " & CStr(Cells(Z, 2)) Else objD.Add Key:=CStr(Cells(Z, 1)), Item:=CStr(Cells(Z, 2)) End If Next Cells(2, 4).Resize(objD.Count) = Application.Transpose(objD.keys) Cells(2, 5).Resize(objD.Count) = Application.Transpose(objD.items) objD.RemoveAll: Set objD = Nothing End Sub

Hallo Werner!
Der TE hat keine Echtdaten gezeigt.
Ohne Doppelte auf die Schnelle:

Sub Mydic()

    Dim objD As Object

    Set objD = CreateObject("scripting.dictionary")

    For Z = 2 To Cells(2, 1).End(xlDown).Row

        If objD.exists(CStr(Cells(Z, 1))) Then

            If InStr(1, objD(CStr(Cells(Z, 1))), Cells(Z, 2)) = 0 Then

                objD(CStr(Cells(Z, 1))) = objD(CStr(Cells(Z, 1))) & ", " & CStr(Cells(Z, 2))

            End If

        Else

            objD.Add Key:=CStr(Cells(Z, 1)), Item:=CStr(Cells(Z, 2))

        End If

    Next

    Cells(2, 4).Resize(objD.Count) = Application.Transpose(objD.keys)

    Cells(2, 5).Resize(objD.Count) = Application.Transpose(objD.items)

    objD.RemoveAll: Set objD = Nothing

End Sub

Gruß Gerd

Beliebteste Forumthreads (12 Monate)

Zelleninhalte zusammenfassen wenn einer Größe zugeordnet

11
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Zelleninhalte zusammenfassen wenn einer Größe zugeordnet

11 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

11
Beiträge zum Forumthread

Beiträge zu diesem Forumthread