AW: löschen wenn gleich
18.07.2005 12:13:02
UweD
Hallo
so könnte es gehen:
Sub lösche()
Dim LR%, ST%, I%, J%, Anz1%, Anz2%
ST = 1 ' Erste Zeile
LR = ActiveSheet.Cells(Rows.Count, 2).End(xlUp).Row 'letzte Zeile der Spalte B
For I = LR To ST + 1 Step -1
For J = 1 To 5 'vergleichen bis Spalte E
If Cells(I, J) = Cells(I - 1, J) Then
If J = 5 Then
'Ermittlung der Anz gefüllter Zellen
Anz2 = Application.CountA(Range(Rows(I), Rows(I)))
Anz1 = Application.CountA(Range(Rows(I - 1), Rows(I - 1)))
If Anz2 < Anz1 Then
Rows(I).Delete
Else
Rows(I - 1).Delete
End If
End If
End If
Next J
Next I
End Sub
Gruß UweD
(Rückmeldung wäre schön)
