|
Hallo resa,
gib ihm doch die Möglichkeit die letzte Bedingung auch auszuführen...
Sub test()
Dim m As Integer
For m = 1 To 20
'Schleife wird durchgeführt, bis sich die Einträge in Spalte A
'voneinander unterscheiden
Do Until Cells(m, 1) <> Cells(m + 1, 1)
If Cells(m, 2) < Cells(m + 1, 2) Then 'Zelle m+1 in Spalte B löschen,
Cells(m + 1, 2).Delete ' wenn diese kleiner ist als die vorherige
End If
If Cells(m, 3) < Cells(m + 1, 3) Then ' Zelle m in Spalte C löschen,
Cells(m, 3).Delete 'wenn diese kleiner ist als die vorherige
End If
Cells(m, 1).Delete 'nach erfolgreicher Abfrage wird die
Loop 'entsprechende Zelle in Spalte A auch gelöscht
If Cells(m + 1, 1) = "" Then
If Cells(m, 2) < Cells(m + 1, 2) Then 'Zelle m+1 in Spalte B löschen,
Cells(m + 1, 2).Delete ' wenn diese kleiner ist als die vorherige
End If
If Cells(m, 3) < Cells(m + 1, 3) Then ' Zelle m in Spalte C löschen,
Cells(m, 3).Delete 'wenn diese kleiner ist als die vorherige
End If
Cells(m, 1).Delete
Exit For 'Abbruchbedingung, falls am Ende angekommen
End If
Next m
End Sub
Gruß Detlev
|