Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo errExit
'Für den Bereich A1 bis D20. Ansonsten kann dieser in der Folgezeile angepasst werden.
If Intersect(Target, Range("A1:D20")) Is Nothing Then Exit Sub 'Bitte den Bereich anpassen
Select Case Target.Value
Case "AB": Target.Interior.ColorIndex = 15 '<- 15 für die Farbe Grau
Case "BC": Target.Interior.ColorIndex = 19
Case "CD": Target.Interior.ColorIndex = 35
Case "DE": Target.Interior.ColorIndex = 40
' Auf Wunsch hier die Reihe fortsetzen
Case Else
Target.Interior.ColorIndex = xlNone
End Select
errExit:
Exit Sub
End Sub
Soll die Bedingung nicht nur bei Zelleingabe sondern auch durch Formelergebnisse geprüft werden, so geht dies mit folgendem Code.
Ebenfalls für das Modul: Tabellenblatt
Idealerweise schreibt man in eine Zelle ( kann versteckt werden ) eine "flüchtige" Formel z.B. =heute()
Dadurch wird sichergestellt, dass bei jeder Eingabe auch eine Berechnung stattfindet.
Als Beispiel für den Bereich A1:B100, ansonsten bitte den Bereich im Code anpassen.
Der Code
Private Sub Worksheet_Calculate()
Dim Zelle As Range
For Each Zelle In Range("A1:B100") ' Bitte den Bereich anpassen
Select Case Zelle.Value
Case "AB": Zelle.Interior.ColorIndex = 15 '<- 15 für die Farbe Grau
Case "BC": Zelle.Interior.ColorIndex = 19
Case "CD": Zelle.Interior.ColorIndex = 35
Case "DE": Zelle.Interior.ColorIndex = 40
' Auf Wunsch hier die Reihe fortsetzen
Case Else
Zelle.Interior.ColorIndex = xlNone
End Select
Next
End Sub
Eine Übersicht, welche Zahl welche Farbe erzeugt gibt es hier:
Farbindex