Hallo hier mal ein Code der das machen sollte. ICh vemute mal, dass in Spalte E der Vorname steht - dort sollten ja die Vornamen zusammengefügt werden. Der Code geht alle Zellen durch und schreibt die Vornamen zusammen, falls Name und ANschrift gleich sind. Es wird dabei aber nicht geschaut, ob gf. am Namensende noch Leerzeichen sind. Die Daten müsssen identisch sein. KÖnnte man aber noch ändern. Gespeichert wird auch nix.
Probiere es mal an einer Beispieldatei. Viele Grüße
Sub zusammenführen()
Dim ende
Dim zeile
Dim anzahl
Dim i
dim j
Dim suche
'alle befüllten Zeilen der Spalte D
ende = ActiveSheet.Cells(Rows.Count, 4).End(xlUp).Row
'D, G, H, I (Nachname, Straße, PLZ und Ort) identisch sein
For i = 1 To ende
'nachname wird gesucht
suche = ActiveSheet.Cells(i, 4)
If suche <> "" Then
anzahl = Application.WorksheetFunction.CountIf(ActiveSheet.Columns(4), suche)
If anzahl < 2 Then
'wert exisiert nur einmal, nix machen
Else
For j = ende To i + 1 Step -1
If ActiveSheet.Cells(j, 4) = suche Then
'prüfen ob Strae PLZ und Ort identisch sind
If ActiveSheet.Cells(j, 8) = ActiveSheet.Cells(i, 8) And ActiveSheet.Cells(j, 7) = ActiveSheet.Cells(i, 7) And ActiveSheet.Cells(j, 9) = ActiveSheet.Cells(i, 9) Then
' Vorname
ActiveSheet.Cells(i, 5) = ActiveSheet.Cells(i, 5) & " " & ActiveSheet.Cells(j, 5)
ActiveSheet.Rows(j).Delete
End If 'vergleich mit name, Straße, PLZ und Ort
End If 'verleich mit wert
Next j
End If 'mehr als einmal den Namen gefunden
End If ' Zelle leer
Next i
End Sub
|