AW: identische Einträge farblich markieren
08.09.2009 05:33:33
fcs
Hallo BartekBartek,
das kannst du auch mit bedingter Formatierung mit Formel erreichen unter Nutzung der ZÄHLENWENN-Funktion.
Bedingte Formatierung für Zelle A1
=WENN(ZÄHLENWENN($A:$B;A1)>=1;WAHR;FALSCH)
Diese Formatierung auf Splaten A und B kopieren.
EIne Makrolösung sieht wie folgt aus.
Gruß
Franz
Sub aaSpalteAundB()
Call Doppeltemarkieren(wks:=ActiveSheet, Spalte1:=1, Spalte2:=2, _
FarbIndex:=3, Zeile1:=2)
End Sub
Sub aaSpalteAundC()
Call Doppeltemarkieren(wks:=ActiveSheet, Spalte1:=1, Spalte2:=3, _
FarbIndex:=3, Zeile1:=2)
End Sub
Sub Doppeltemarkieren(wks As Worksheet, Spalte1 As Long, Spalte2 As Long, _
FarbIndex As Long, Optional Zeile1 As Long = 1)
'wks = Tabellenblatt in dem Formatiert werden soll
'Spalte1 = 1. der zu vergleichenden Spalten
'Spalte2 = 2. der zu vergleichenden Spalten
'Farbindex= Colorindex der zu verwendenden Füllfarbe
'Zeile1 = Startzeile, ab der verglichen werden soll, Standardwert = 1
Dim LastRow As Long, Bereich1 As Range, Bereich2 As Range, Zelle As Range
With wks
LastRow = .Cells.SpecialCells(xlCellTypeLastCell).Row
Set Bereich1 = .Range(Cells(Zeile1, Spalte1), .Cells(LastRow, Spalte1))
Set Bereich2 = .Range(Cells(Zeile1, Spalte2), .Cells(LastRow, Spalte2))
Bereich1.Interior.ColorIndex = xlColorIndexNone
Bereich2.Interior.ColorIndex = xlColorIndexNone
Application.ScreenUpdating = False
For Each Zelle In Bereich1
If Application.WorksheetFunction.CountIf(Bereich1, Zelle.Value) _
+ Application.WorksheetFunction.CountIf(Bereich2, Zelle.Value) > 1 Then
Zelle.Interior.ColorIndex = FarbIndex
End If
Next
For Each Zelle In Bereich2
If Application.WorksheetFunction.CountIf(Bereich1, Zelle.Value) _
+ Application.WorksheetFunction.CountIf(Bereich2, Zelle.Value) > 1 Then
Zelle.Interior.ColorIndex = FarbIndex
End If
Next
Application.ScreenUpdating = True
End With
End Sub