AW: Doppelte Einträge nach Datum löschen
31.07.2006 09:41:33
Marcel
hab mir jetzt mal selber was gebastelt. das funzt auch...
Private Sub CommandButton1_Click()
Dim reihe As Long
Dim i As Long
'-Letze beschriebene Zeile in Spalte A finden
i = 3
Do
If ActiveSheet.Cells(i, 1) <> "" Then
i = i + 1
End If
Loop Until ActiveSheet.Cells(i, 1) = ""
i = i - 1
'-Erst nach Namen, dann nach Zugriff Sortieren. Letzter Zugriff oben
Range(Cells(1, 1), Cells(i, 2)).Select
Selection.Sort Key1:=Range("A1"), Order1:=xlAscending, Key2:=Range("B1") _
, Order2:=xlDescending, Header:=xlGuess, OrderCustom:=1, MatchCase:= _
False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, DataOption2 _
:=xlSortNormal
'- Überprüft, ob sich in Spalte A zwei gleiche Namen befinden. Der ältere Eintrag wird
'- gelöscht
reihe = 1
Do
If Cells(reihe, 1) = Cells(reihe + 1, 1) Then
If Cells(reihe, 2) >= Cells(reihe + 1, 2) Then
Rows(reihe + 1).Select
Selection.Delete Shift:=xlUp
End If
End If
reihe = reihe + 1
Loop Until Cells(reihe, 1) = ""
'- Nach Zugriffsdatum sortieren. Letzer Zugriff oben
Range(Cells(1, 1), Cells(i, 2)).Select
Selection.Sort Key1:=Range("B1"), Order1:=xlDescending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
End Sub