Thema: bedingte Formatierung bei 15 Kriterien

Hallo !
Ich möchte einer Zelle eine bestimmte Farbe zuweisen und zwar anhand
von 15 verschiedenen Kriterien, welche in der Spalte A ermittelt werden.
Beispiel:
Zelle mit Wert-Spalte A Zelle mit Farbe - Spalte B
A1 "1" automatische Farbzuweisung in B1 "rot"
A2 "2" automatische Farbzuweisung in B2 "blau"
A3 "9" automatische Farbzuweisung in B3 "schwarz"
A4 "1" automatische Farbzuweisung in B4 "rot"
A5 "2" automatische Farbzuweisung in B5 "blau"
A6 "15" automatische Farbzuweisung in B6 "gelb"
Da mit der bedingten Formatierung nur
drei Kriterien möglich sind, ich aber 15 Möglichkeiten habe benötige Eure Hilfe.
Für eine Rückinfo wäre ich sehr dankbar.
Gruss
Bernhard

Hallo Bernhard,

Private Sub Worksheet_Change(ByVal Target As Range) 'Code in das entsprechende Tabellenblatt If Not Intersect(Target, [A1:A20]) Is Nothing And Target.Count = 1 Then   With Target     Select Case Target       Case 1: .Offset(0, 1).Interior.ColorIndex = 3       Case 2: .Offset(0, 1).Interior.ColorIndex = 5       Case 9: .Offset(0, 1).Interior.ColorIndex = 1       Case 15: .Offset(0, 1).Interior.ColorIndex = 6       'usw       Case Else: .Offset(0, 2).Interior.ColorIndex = xlNone     End Select   End With End If End Sub Gruss Jürgen

VBA-Code:

Private Sub Worksheet_Change(ByVal Target As Range) 'Code in das entsprechende Tabellenblatt 'Bereich auf deine Bedürfnisse anpassen! If Not Intersect(Target, [A1:A20]) Is Nothing And Target.Count = 1 Then   With Target     Select Case Target       Case 1: .Offset(0, 1).Interior.ColorIndex = 3       Case 2: .Offset(0, 1).Interior.ColorIndex = 5       Case 9: .Offset(0, 1).Interior.ColorIndex = 1       Case 15: .Offset(0, 1).Interior.ColorIndex = 6       'usw       Case Else: .Offset(0, 1).Interior.ColorIndex = xlNone     End Select   End With End If End Sub

Hallo
Das ist ein wirklich guter Tipp, den man oft verwenden kann.
Wie würde der Code aussehen, wenn ein Bereich neben der Eingabezelle gefärbt werden soll (zB die nächsten 4 Zellen nach rechts)?
Gruss Peter

Hi Peter,

VBA-Code:

Private Sub Worksheet_Change(ByVal Target As Range) 'Code in das entsprechende Tabellenblatt 'Bereich auf deine Bedürfnisse anpassen! If Not Intersect(Target, [A1:A20]) Is Nothing And Target.Count = 1 Then   With Target     Select Case Target       Case 1: Range(.Offset(0, 1), .Offset(0, 4)).Interior.ColorIndex = 3       Case 2: Range(.Offset(0, 1), .Offset(0, 4)).Interior.ColorIndex = 5       Case 9: Range(.Offset(0, 1), .Offset(0, 4)).Interior.ColorIndex = 1       Case 15: Range(.Offset(0, 1), .Offset(0, 4)).Interior.ColorIndex = 6       'usw       Case Else: Range(.Offset(0, 1), .Offset(0, 4)).Interior.ColorIndex = xlNone     End Select   End With End If End Sub Gruss Jürgen

Hallo Jürgen
klappt wunderbar, vielen Dank für Deine Hilfe
herzliche Grüße Peter

Hallo Bernhard,
die Farbnummern bekommst Du so:

Sub Farbnummern() Dim i As Integer For i = 1 To 56   Cells(i, "A").Interior.ColorIndex = i Next End Sub Gruss Jürgen