Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1800to1804
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

VBA Gleiche Zeilen zusammenführen

VBA Gleiche Zeilen zusammenführen
28.12.2020 22:47:42
Manuela
Hi!
Ich möchte mehrere Zeilen einer Tabelle zusammenfassen. Dabei soll für alle Einträge bei denen der Zelleninhalt über alle Spalten mit Ausnahme einer festgelegten Spalte gleich ist, nur noch eine Zeile in der Tabelle aufgeführt werden. In der letzten Spalte der dann einzelnen Zeile, sollen alle Werte die vorher einzeln in mehreren Zeilen aufgeführt waren, hintereinander in einer einzelnen Zelle stehen.
Kurzbeispiel:
Zeile 1: X Y Z1
Zeile 2: X Y Z2
soll folgendermaßen aussehen
Zeile zusammengefasst : X Y Z1, Z2
Die Lösung sollte wenn möglich über ein Makro abgedeckt werden, da die Tabelle sehr viele Daten beinhaltet.
Mein Problem visuell dargestellt:
https://www.herber.de/bbs/user/142631.xlsx
Ich habe es mit einer verketteten For Each Schleife probiert, habe aber damit ein falsches Ergebnis erhalten...
Danke schonmal im Voraus ;)

5
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: VBA Gleiche Zeilen zusammenführen
29.12.2020 00:19:30
Yal
Hallo Manuella,
For-Schleife ist richtig. Es funktioniert nur, wenn nach es nach Spalte 1 und 2 sortiert ist.
Sub Verkettet_pivotieren()
Const ErsteZeile = 4
Dim Z
Dim msg As String
Dim Zaehler As Integer
'Erste Zeile hat noch keine Vorgänger
msg = Me.Cells(ErsteZeile, 3)
Zaehler = 0
For Z = ErsteZeile + 1 To Me.Range("A1000").End(xlUp).Row
If Me.Cells(Z, 1) & Me.Cells(Z, 2) = Me.Cells(Z - 1, 1) & Me.Cells(Z - 1, 2) Then
' Die aktuelle ist gleich wie vorherige
msg = msg & ";" & Me.Cells(Z, 3)
Zaehler = Zaehler + 1
Else
' Die aktuelle ist nicht gleich
If Zaehler > 0 Then
Me.Range("E1000").End(xlUp).Offset(1, 0) = Me.Cells(Z - 1, 1)
Me.Range("E1000").End(xlUp).Offset(0, 1) = Me.Cells(Z - 1, 2)
Me.Range("E1000").End(xlUp).Offset(0, 2) = msg
End If
msg = Me.Cells(Z, 3)
Zaehler = 0
End If
Next
End Sub
Viel Erfolg
Yal
Anzeige
Excel-Version ohne Relevanz?
29.12.2020 08:18:21
RPP63
Moin!
Die Version ist sehr wohl relevant!
In meinem Excel 365, aber auch in Excel-Online sind das simple Formeln:
 ABCDEFG
1How it is   How it should look like  
2       
3Spalte1Spalte2Spalte3 Spalte1Spalte2Spalte3
4AxStringX AxStringX; StringY
5AxStringY AyStringZ
6AyStringZ AhStringX; StringD
7AhStringX AgStringZ
8AhStringD BxStringZ; StringC
9AgStringZ ByStringZ
10BxStringZ    
11ByStringZ    
12BxStringC    

ZelleFormel
E4=EINDEUTIG(A4:B12)
G4=TEXTVERKETTEN("; ";1;FILTER(C$4:C$12;A$4:A$12&B$4:B$12=E4&F4))
G5=TEXTVERKETTEN("; ";1;FILTER(C$4:C$12;A$4:A$12&B$4:B$12=E5&F5))
G6=TEXTVERKETTEN("; ";1;FILTER(C$4:C$12;A$4:A$12&B$4:B$12=E6&F6))
G7=TEXTVERKETTEN("; ";1;FILTER(C$4:C$12;A$4:A$12&B$4:B$12=E7&F7))
G8=TEXTVERKETTEN("; ";1;FILTER(C$4:C$12;A$4:A$12&B$4:B$12=E8&F8))
G9=TEXTVERKETTEN("; ";1;FILTER(C$4:C$12;A$4:A$12&B$4:B$12=E9&F9))

Gruß Ralf
Anzeige
AW: VBA Gleiche Zeilen zusammenführen
29.12.2020 08:18:42
ChrisL
Hi
Da die Tabelle wie du schreibst sehr viele Daten hat, würde ich erst recht eine Power-Query Lösung vorziehen. Die verwendete Excel-Version ist relevant.
https://www.herber.de/bbs/user/142634.xlsx
Bei Interesse Power-Query Intro Video schauen und bei Bedarf mit Fragen melden.
cu
Chris
AW: VBA Gleiche Zeilen zusammenführen
29.12.2020 08:44:49
Daniel
Hi
1. Liste nach Spalte A und B sortieren
2. In Zelle D4 die Formel, diese Formel nach unten ziehen:
=C4&Wenn(Und(A5=A4;B5=B4);"; "&D5;"")
3. Spalte D kopieren und als Wert einfügen
4. Auf die Tabelle die Funktion Daten - Datentools - Duplikate entfernen anwenden mit Spalte A und B als Kriterium.
5. Spalte C löschen.
Wenn als Makro benötigt, einfach diese Schritte per Makro ausführen lassen.
Gruß Daniel
Anzeige
AW: VBA Gleiche Zeilen zusammenführen
29.12.2020 12:26:41
Herbert_Grom
Hallo Manuela,
schau dir mal meinen Vorschlag an. Ich habe Yal's Code noch etwas angepasst.
https://www.herber.de/bbs/user/142640.xlsm
Servus

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige