Re: doppelte Datensätze löschen
02.12.2002 14:08:46
Detlef
Hallo Ulrich,hier habe ich vielleicht noch was für Dich.
Gruß Detlef
Sub DoppelteSätzeEliminieren()
Dim Spalte As String
Dim Tabelle As String
Spalte = InputBox("In Welcher Spalte" _
& Chr(13) & "doppelte Sätze elemenieren?" _
& Chr(13) & Chr(13) & "Buchstabe der Spalte eingeben!", _
"Doppelte Sätze Eliminieren")
If Spalte = "" Then Exit Sub
Tabelle = InputBox("In welcher Tabelle" _
& Chr(13) & "doppelte Sätze elemenieren?" _
& Chr(13) & Chr(13) & "Tabelle Namen eingeben!", _
"Doppelte Sätze Eliminieren")
If Spalte = "" Then Exit Sub
'Aktualisierung im Hintergrund
Application.ScreenUpdating = False
Sheets(Tabelle).Activate
'zuerst sortieren
Columns("a:iv").Select
Selection.Sort Key1:=Range(Spalte & "1"), Order1:=xlAscending, _
Header:=xlGuess, OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom
'jetzt doppelte Sätze rausschmeißen
Range(Spalte & "1").Select
Do Until ActiveCell.Value = ""
If ActiveCell.Value = ActiveCell.Offset(1, 0).Value _
Then ActiveCell.EntireRow.Delete _
Else ActiveCell.Offset(1, 0).Select
Loop
Application.ScreenUpdating = True
End Sub