Fehler im VBA
10.07.2016 17:31:18
KiBi
ich habe in VBA einen Code erstellt, der Dubletten löscht und anschließend nach Datum sortiert. Irgendwo scheint allerdings noch ein Fehler zu sein. Kann sich das vielleicht mal jemand ansehen. Wäre echt super. vielen Dank!!!
Als Info vorab: Spalte C ist der Name nach dem die Dubletten gesucht werden
Spalte D ist das Zugriffsdatum. Das jüngste Datum soll dabei stehen bleiben (also ältere Einträge sollen entfernt werden).
vielen, vielen Dank!! Ich bekomms einfach nicht hin :-/
----------------------------------------
Private Sub CommandButton1_Click()
Dim reihe As Long
Dim i As Long
i
'-Letze beschriebene Zeile in Spalte D finden
i = 3
Do
If ActiveSheet.Cells(i, 4) "" Then
i = i + 1
End If
Loop Until ActiveSheet.Cells(i, 4) = ""
i = i - 1
'-Erst nach Namen (spalte C), dann nach Zugriff (spalte D) Sortieren. Letzter Zugriff oben
Range(Cells(1, 1), Cells(i, 9)).Select
Selection.Sort Key1:=Range("C1"), Order1:=xlAscending, Key2:=Range("D1") _
, Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:= _
False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, DataOption2 _
:=xlSortNormal
'- Überprüft, ob sich in Spalte C zwei gleiche Namen befinden. Der ältere Eintrag wird
'- gelöscht
reihe = 1
Do
If Cells(reihe, 3) = Cells(reihe + 1, 3) Then
If Cells(reihe, 4) >= Cells(reihe + 1, 4) 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, 9)).Select
Selection.Sort Key1:=Range("D1"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
End Sub