'entwickelt von Winfried Radner
'e-mail: Wolf.W.Radzinski@onlinehome.de
'Benutzung frei - ohne Gewähr


'markiere die zu prüfende Spalte und rufe danach ident_rows auf
'löscht alle Zeilen (bis auf die Erste, die in der zu prüfenden Spalte
'identische Werte haben

Sub ident_rows()
startzeile = ActiveCell.Row  'suche aufwärts ab der aktuell aktivierten Zeile
'startspalte = ActiveCell.Column
i = startzeile
geloeschte_zeilen = 0
Do
j = i + 1
gleich = False
Do
   Application.StatusBar = "i=" & i & " j=" & j & " gelöscht=" & geloeschte_zeilen
   
   
   If ist_gleich(i, j) Then
      Rows(j).Delete
      geloeschte_zeilen = geloeschte_zeilen + 1
   Else
      j = j + 1
   End If
Loop Until IsEmpty(Cells(j, ActiveCell.Column))
   i = i + 1
Loop Until IsEmpty(Cells(i, ActiveCell.Column))
End Sub


Function ist_gleich(ByVal a, ByVal b) As Boolean
  ist_gleich = False
  If Cells(a, ActiveCell.Column).Value = Cells(b, ActiveCell.Column).Value Then
      ist_gleich = True
  End If
End Function