Doppeleinträge finden und zusammenfassen

Hallo ihr Profis!
Ich hoffe, mein Problem ist nicht so unlösbar wie es scheint:
Also, ich habe hier eine Kontaktliste mit ca. 11.000 Einträgen vor mir, und außerdem hat jeder Kontakt so ca. 30 Eigenschaften.
Also 11.000 Zeilen, 30 Spalten.
Diese Tabelle muss auf Doppeleinträge überprüft werden, also ob ein Name mehrmals vorkommt.
Personenname natürlich, die verschiedenen Firmen kommen x-fach vor und das soll auch so sein.
Problem #1 wäre also: bietet Excel mir eine Suchfunktion an, die speziell danach sucht ob etwas doppelt vorkommt?
Wenn ich dann einen Doppeleintrag gefunden habe (in manchen Fällen sinds auch 3fache), fasse ich diese zusammen, denn für gewöhnlich haben diese unterschiedliche Spalteneinträge, die in einen Gesamteintrag zusammengefasst werden sollen.
Problem #2 ist demnach: Im Moment vergleiche ich die beiden Einträge Spalte für Spalte, und kopiere dann die Inhalte zusammen, und lösche danach eine Spalte. Kann ich mir das automatisieren bzw halbwegs automatisieren?
Beispiel:
Firma-Vorname-Name-----EigenschaftA-EigenschaftB
XAG---Martin-----Muster---------------x
XAG---Martin-----Muster-----------------------------x
soll werden:
Firma-Vorname-Name---EigenschaftA-EigenschaftB
XAG----Martin-----Muster--------------x----------------x
Vielen Dank schonmal im vorraus auch wenn vielleicht nur eines der beiden Probleme gelöst werden könnte wäre das schon eine riesenhilfe!
Gruß
Daniel

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

hi daniel :)
hier zwei beispiele :)
gruss nighty
einmal zellen bezogen bzw. zeilen bezogen


Sub liste_erstellen()
Dim zaehler1 As Long
Dim letzte As Long
Dim suche1 As Range
With Worksheets(2)
.Range("A1:C65535").Clear
For zaehler1 = 1 To Sheets(1).UsedRange.SpecialCells(xlCellTypeLastCell).Row
Set suche1 = Worksheets(1).Range("A" & zaehler1 + 1 & ":A65535").Find(Worksheets(1).Cells(zaehler1, 1).Value)
If Not suche1 Is Nothing Then
Sheets(1).Rows(suche1.Row).Copy
letzte = Sheets(2).UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1
.Rows(letzte & ":" & letzte).Insert Shift:=xlDown
Sheets(1).Application.CutCopyMode = False
End If
Next zaehler1
End With
End Sub


Sub liste_erstellen2()
Dim zaehler1 As Long
Dim suche1 As Range
With Worksheets(2)
.Range("A1:C65535").Clear
For zaehler1 = 1 To Sheets(1).UsedRange.SpecialCells(xlCellTypeLastCell).Row
Set suche1 = Worksheets(1).Range("A" & zaehler1 + 1 & ":A65535").Find(Worksheets(1).Cells(zaehler1, 1).Value)
If Not suche1 Is Nothing Then
.Cells(Sheets(2).UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1, 1).Value = Sheets(1).Cells(suche1.Row, 1).Value
End If
Next zaehler1
End With
End Sub

Beliebteste Forumthreads (12 Monate)

Doppeleinträge finden und zusammenfassen

2 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread