Microsoft Excel

Herbers Excel/VBA-Archiv

bedingte Formatierung bei 15 Kriterien

Betrifft: bedingte Formatierung bei 15 Kriterien von: Zürn Bernhard
Geschrieben am: 22.07.2008 19:39:22

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

  

Betrifft: Mit VBA von: Backowe
Geschrieben am: 22.07.2008 19:49:31

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
Code eingefügt mit Syntaxhighlighter 4.15


Gruss Jürgen


  

Betrifft: Tippfehler verbessert von: Backowe
Geschrieben am: 22.07.2008 21:50:38

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
Code eingefügt mit Syntaxhighlighter 4.15



  

Betrifft: AW: zusätzliche Frage von: Peter
Geschrieben am: 23.07.2008 07:45:06

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


  

Betrifft: AW: zusätzliche Frage von: Backowe
Geschrieben am: 23.07.2008 09:54:35

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

Code eingefügt mit Syntaxhighlighter 4.15


Gruss Jürgen


  

Betrifft: AW: zusätzliche Frage von: Peter
Geschrieben am: 23.07.2008 10:55:12

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


  

Betrifft: Farbnummern von: Backowe
Geschrieben am: 22.07.2008 19:57:34

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
Code eingefügt mit Syntaxhighlighter 4.15


Gruss Jürgen


 

Beiträge aus den Excel-Beispielen zum Thema "bedingte Formatierung bei 15 Kriterien"