Bedingte formatierung mit mehr als 3 werten

Question

Hallo Leute!
Ich habe ein kleines bis mittelgroßes Excel Problem. Bitte um hilfe, ich brauche das für meine dipomarbeit und ich kriege es nich gebacken. Ist wahrscheinlich super einfach, komme aber trotzdem nicht drauf.

Folgendes Problem:
Ich möchte alle Felder in denen der Buchstabe A B C oder D farblich markieren und zwar unabhängig davon ob ich den wert selber eingebe oder der aus einer fomel kommt.

dabei soll
A = Grün werden
B = Gelb
C= Rot
D= Schwarz und Schrift weiss
Mit bedingter formatierung geht es nich weil ich excel 2003 benutze und man da nur 3 bedingte formatierungen einstellen kann.

Habe es schon mit folgendem Marko versucht und es funktioniert auch allerdings nur wenn ich neue felder eintippe. Felder die den Buchstaben aus einer Formel habe werden nicht umgefärbt.

Private Sub Worksheet_Change(ByVal Target As Range)
'Wenn mehr als eine Zelle markiert wurde dann Makro beenden


Select Case Target
Case "A"
Cells(Target.Row, Target.Column).Interior.ColorIndex = 4
Case "B"
Cells(Target.Row, Target.Column).Interior.ColorIndex = 6
Case "C"
Cells(Target.Row, Target.Column).Interior.ColorIndex = 3
Case "D"
Cells(Target.Row, Target.Column).Interior.ColorIndex = 1
Cells(Target.Row, Target.Column).Font.ColorIndex = 2
Case Else
Target.Interior.ColorIndex = 0
End Select
End Sub

Wenn ich hier A eingebe, dann färbt er mir das Feld Grün. Das ist wunderbar, allerdings habe ich eine andere Formel, die als Ergebniss A haben und diese werden nicht umgefärbt. Ich möchte aber einfach alle A´s in Grün habe. (+ B, C und D)


Bitte um (schnelle) hife, danke
gruß Micha

Answer 1

Hallo Micha,

ich hoffe, ich habe Dich richtig verstanden. Nachfolgender VBA-Code färbt Dir in dem Bereich, in dem die Daten stehen, entsprechend der Select Case-Anweisung die Zellhintergründe.

Kopiere den Code in das VBA-Projekt des Tabellenblatts, in dem die Anweisung wirken soll.
Teste das Makro aber bitte in einer Testdatei und nicht gleich in Deiner Originaldatei.

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
Dim lngLastRow As Long
Dim intLastColumn As Integer
Dim rngCell As Range

lngLastRow = ActiveSheet.Cells.Find("*", searchdirection:=xlPrevious).Row
intLastColumn = ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Column

For Each rngCell In Range(Cells(1, 1), Cells(lngLastRow, intLastColumn))

Select Case rngCell.Value
Case "A"
Cells(rngCell.Row, rngCell.Column).Interior.ColorIndex = 4
Case "B"
Cells(rngCell.Row, rngCell.Column).Interior.ColorIndex = 6
Case "C"
Cells(rngCell.Row, rngCell.Column).Interior.ColorIndex = 3
Case "D"
Cells(rngCell.Row, rngCell.Column).Interior.ColorIndex = 1
Cells(rngCell.Row, rngCell.Column).Font.ColorIndex = 2
Case Else
rngCell.Interior.ColorIndex = 0
End Select
Next
End Sub
MfG,
Oliver
[sub]Da hier der einzige Lohn für die Helfer eine Rückmeldung ist, wäre es nett, wenn Du[/sub]
[sup] ein Feedback abgeben könntest, ob der Lösungsvorschlag Dein Problem gelöst hat.[/sup]