Option Explicit
Sub Erste_Spalte_DoppelteWerte_suchen_ohne_Sort()
'bei Ausführung des Makros muß das zu untersuchende Blatt aktiviert sein
Const c_ersteZeile_mitWert = 2->anpassen !!!!!!!
Const c_Spalte = 1
Dim ws As Worksheet, l_Rows As Long, z1 As Long, z2 As Long
Set ws = ActiveSheet
l_Rows = ws.Cells(Rows.Count, 1).End(xlUp).Row
For z1 = c_ersteZeile_mitWert To l_Rows - 1
->leere Werte nicht vergleichen
If ws.Cells(z1, c_Spalte).Value <> Then
For z2 = z1 + 1 To l_Rows
If ws.Cells(z1, c_Spalte).Value = ws.Cells(z2, c_Spalte).Value Then
->doppelten Wert Rot hinterlegen
ws.Cells(z2, c_Spalte).Interior.ColorIndex = 3
End If
Next
End If
Next
End Sub
'*******************************************************
Sub Erste_Spalte_DoppelteWerte_suchen_mit_Sort()
'bei Ausführung des Makros muß das zu untersuchende Blatt aktiviert sein
Const c_ersteZeile_mitWert = 2->anpassen !!!!!!!
Const c_Spalte = 1
Dim ws As Worksheet, l_Rows As Long, z1 As Long, z2 As Long
Set ws = ActiveSheet
->nach erster Spalte sortieren
ws.Select
Selection.Sort _
Key1:=Range(Cells(1, c_Spalte), Cells(1, c_Spalte)), Order1:=xlAscending, _
Header:=xlYes, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
l_Rows = ws.Cells(Rows.Count, 1).End(xlUp).Row
For z1 = c_ersteZeile_mitWert To l_Rows - 1
->leere Werte nicht vergleichen
If ws.Cells(z1, c_Spalte).Value <> Then
For z2 = z1 + 1 To l_Rows
If ws.Cells(z1, c_Spalte).Value = ws.Cells(z2, c_Spalte).Value Then
->doppelten Wert Rot hinterlegen
ws.Cells(z2, c_Spalte).Interior.ColorIndex = 3
Else
Exit For
End If
Next
End If
Next
End Sub
