Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1392to1396
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

Dublikate in Mehrzeiler zusammenfassen

Dublikate in Mehrzeiler zusammenfassen
25.11.2014 11:31:36
Artanan
Hallo
ich habe eine Tabelle mit Dublikaten (seriennummern). da aber in manchen spalten trotzdem unterschiedliche einträge sind, möchte ich die dublikate nicht löschen sondern in einer zeile zusammenfassen. dazu wollte ich die zellinhalte in eine Zelle als mehrzeiler zusammenfügen.
folgenden code habe ich bisher geschrieben:
 letztespalte = Sheets(a).Cells(1, 256).End(xlToLeft).Column
For h = Sheets(a).Cells(Rows.Count, 1).End(xlUp).Row To 2 Step -1
If Sheets(a).Cells(h, 1) = Sheets(a).Cells(h - 1, 1) Then
For j = 2 To letztespalte
Sheets(a).Cells(h - 1, j) = Sheets(a).Cells(h, j) & Chr(10) & Sheets(a).Cells(h -1, _
j)
Next
Sheets(a).Rows(h).Delete
End If
Next

ich würde jetzt gerne noch einbauen, dass gleiche eintäge nicht zusammengefügt werden. hat hier jmd eine idee?
In der Beispieldatei ist das ganze mal als Vorher/Nachher zu sehen. Es soll aber im gleichen Blatt ablaufen. Also nicht ein neues blatt generieren.

Die Datei https://www.herber.de/bbs/user/93846.xlsm wurde aus Datenschutzgründen gelöscht

3
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Duplikate in Mehrzeiler zusammenfassen
25.11.2014 12:25:11
Rudi
Hallo,
teste mal:
Sub aaaa()
Dim objDic(1 To 8) As Object, oDicA, oDicB, arrIn, arrOut(), i As Long, j As Long
For i = 1 To 8
Set objDic(i) = CreateObject("scripting.dictionary")
Next
arrIn = ActiveSheet.Cells(1, 1).CurrentRegion
For i = 1 To UBound(arrIn)
objDic(1)(arrIn(i, 1)) = 0
For j = 2 To UBound(arrIn, 2)
objDic(j)(arrIn(i, 1) & "|" & arrIn(i, j)) = arrIn(i, j)
Next
Next
ReDim arrOut(1 To objDic(1).Count, 1 To 8)
i = 0
For Each oDicA In objDic(1)
i = i + 1
arrOut(i, 1) = oDicA
For j = 2 To 8
For Each oDicB In objDic(j)
If Split(oDicB, "|")(0) = oDicA Then
If arrOut(i, j) = "" Then
arrOut(i, j) = objDic(j)(oDicB)
Else
arrOut(i, j) = arrOut(i, j) & vbLf & objDic(j)(oDicB)
End If
End If
Next oDicB
Next j
Next oDicA
With ActiveSheet
.Cells.ClearContents
.Cells(1, 1).Resize(UBound(arrOut), UBound(arrOut, 2)) = arrOut
End With
End Sub

Gruß
Rudi

Anzeige
AW: Duplikate in Mehrzeiler zusammenfassen
25.11.2014 13:54:58
Artanan
Perfekt...vielen lieben Dank.
Klappt einwandfrei. :D

AW: Duplikate in Mehrzeiler zusammenfassen
26.11.2014 11:18:05
Artanan
falls du das noch liest @rudi:
kann man den code noch anpassen, dass dublikate nicht nur nach der spalte a (seriennummer), sondern aus einer kombination aus den ersten drei spalten bestimmt werden? also nur wenn seriennummer und die nächsten beiden spalten identisch sind?
die restlichen spalten werden dann wie gehabt zusammengefasst.

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige