Office: (Office 2016 Mac) mehrere Zeilen in eine Zeile zusammenfassen/zusammenschieben

Hallo zusammen,

ich hoffe ihr könnt mir helfen:

ich habe eine xls-Datei mit mehreren Zeilen an E-Mail-Adressen. Diese kommen untereinander mehrmals vor. Pro Zeile steht in den Spalten noch zusätzliche Info dabei - z.b. in Spalte B das angegebene Land. In jeder Zeile steht auch noch die Teilnahme an Veranstaltungen - je eine pro Zeile - wobei Veranstaltung 1 in Spalte C, Veranstaltung 2 in Spalte D, usw. steht. Die Veranstaltungen sind aber von den Leuten hinter den Mailadressen nur unregelmäßig besucht wurden.

Ich hätte gerne diese Informationen auf je eine Zeile pro E-Mail adresse zusammen "geschoben", damit ich sehe welche E-Mail adresse aus welchem Land kommt und in welchen Veranstaltungen sie war.

Ich hab eine Demo Xls hochgeladen und hoffe jemand kann mir helfen.

Vielen Dank schon vorab!!!

Liebe Grüße!

 

Hi,

das kannst du mit folgendem Makro lösen:

Code:

Sub Zusammen()
    Dim lngZeile As Long
    Dim intSpalte As Integer
    Dim lngAnzahl As Long
    For lngZeile = 17 To 2 Step -1
        If Cells(lngZeile, 1) = Cells(lngZeile - 1, 1) Then
            lngAnzahl = Application.CountIf(Columns(1), Cells(lngZeile, 1))
            intSpalte = Cells(lngZeile, 2).End(xlToRight) + 2
            Cells(lngZeile - lngAnzahl + 1, intSpalte) = Cells(lngZeile, intSpalte)
            If Cells(lngZeile, 2) <> "" Then Cells(lngZeile - lngAnzahl + 1, 2) = Cells(lngZeile, 2)
            Range(Cells(lngZeile, 1), Cells(lngZeile, 7)).ClearContents
        End If
    Next lngZeile
    Columns("A").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End Sub

Bis später,
Karin

 

Hi Karin,

vielen Dank für den Code. Er funktioniert leider nur teilweise - ich kann nicht sagen woran es liegt. Die ersten paar Zeilen klappen wunderbar, dann nicht mehr.

Viele Grüße,
Alex

 

Hi Alex,

in deiner hochgeladenen mappe funktioniert der Code so wie er soll - wenn deine Originalmappe anders aussieht, dann kann ich leider nichts dazu sagen, da ich sie in diesme Fall nicht kenne.
Da du schreibst, dass nur die ersten Zeilen korrekt umgesetzt werden, kann es möglicherweise daran liegen, dass nur die Zeilen 17 bis 2 bearbeitet werden - so ist es im Code festgelegt. Wenn du mehr als 17 Zeilen hast, dann ersetze die 17 im Code durch den folgenden Ausdruck:

Code:

 IIf(IsEmpty(Cells(Rows.Count, 1)), Cells(Rows.Count, 1).End(xlUp).Row, Rows.Count)

Bis später,
Karin

 

Weltklasse DANKE!!! :) Daran hat's gelegen... bei mir sind's gut 2600 Zeilen ;)

 

Ich hab ein ähnliches Problem. Ich hab eine Tabelle mit über 200000 Suchbegriffen zu 30.000 Artikeln. Spalte A sind die Artikelnummern mehrfach vorhanden, Spalte B der passende Suchbegriff. Für einen Import in den Shop brauch die Suchbegriffe alle hinter der Artikelnummer. Entweder getrennt durch Semikolon oder in einzelen Spalten.

 

Das kannst du mit folgendem Code lösen, wobei Bedingung ist, dass vorher nach Spalte A sortiert wurde:

Code:

Sub Zusammen()
    Dim lngZeile As Long
    Dim intSpalte As Integer
    Dim lngAnzahl As Long
    Dim lngZiel As Long
    lngZiel = 2
    For lngZeile = 2 To IIf(IsEmpty(Cells(Rows.Count, 1)), Cells(Rows.Count, 1).End(xlUp).Row, Rows.Count)
        If Cells(lngZeile, 1) = Cells(lngZeile - 1, 1) Then
            lngAnzahl = Application.CountIf(Columns(1), Cells(lngZeile, 1))
            Worksheets("Export").Cells(lngZiel, 1) = Cells(lngZeile, 1)
            Worksheets("Export").Cells(lngZiel, 2).Resize(1, lngAnzahl) = _
                Application.Transpose(Range(Cells(lngZeile, 2), Cells(lngZeile + lngAnzahl - 1, 2)))
            lngZiel = lngZiel + 1
            lngZeile = lngZeile + lngAnzahl - 2
        End If
    Next lngZeile
End Sub

Bis später,
Karin

 

Juhu Spitze. Der Prozessessor hat zwar lange und hart gearbeitet, aber es hat geklappt.
Vielen Dank!