AW: Doppelte Zahlenpaare markieren
15.03.2011 19:53:53
Reinhard
Hallo Rainer,
mit Hilfsspalte in T:
Option Explicit
Sub Doppelte()
Dim MaxZei As Long, Zei As Long, Farbe As Integer, Zei2 As Long
ActiveSheet.Cells.Interior.ColorIndex = xlNone
MaxZei = Cells(Rows.Count, 1).End(xlUp).Row
Farbe = 3
For Zei = 1 To MaxZei
If Application.CountIf(Columns(1), Cells(Zei, 1).Value) > 1 Then
If Cells(Zei, 20).Value "x" Then
Cells(Zei, 1).Interior.ColorIndex = Farbe
Cells(Zei, 20).Value = "x"
For Zei2 = Zei + 1 To MaxZei
If Cells(Zei2, 1).Value = Cells(Zei, 1).Value Then
Cells(Zei2, 1).Interior.ColorIndex = Farbe
Cells(Zei2, 20).Value = "x"
End If
Next Zei2
Select Case Farbe
Case 27
Farbe = 33
Case 33
Farbe = 35
Case 53
Farbe = 55
Case 56
Farbe = 3
Case Else
Farbe = Farbe + 1
End Select
End If
End If
Next Zei
Columns(20).ClearContents
End Sub
Gruß
Reinhard