Bedingte Formatierung mit Farben

  • #1
F

falcon35

Guest
Hallo,

ich habe in der Spalte C in den Zeilen 15 bis 25 drei verschieden Farben (Rot, Gelb, Grün) und noch folgende einträge: - und nicht relevant.

Wenn in einer der Zeilen 15 bis 25 Rot ist dann Rot
Wenn in einer der Zeilen 15 bis 25 kein Rot und mindestens einmal gelb dann gelb
Wenn in einer der Zeilen 15 bis 25 kein Rot , kein gelb und mindestens einmal grün dann grün
Ansonsten Weiß

Vielen Dank im Voraus

Grüße
falcon35
 
  • #2
Hi Falcon35,

in einer Formel Farben einer Zelle abzufragen funktioniert meines Wissens nicht.
Welche Kriterien führen denn dazu, dass die Zellen eingefärbt werden? Oder erfolgt das von Hand.

Gruß Matjes :)
 
  • #3
Hallo Matjes,

die Formatierung wird anhand von Gültigkeitsfeldern duchgeführt:
Gültigkeit: Gelb;Grün;Rot;-;nicht relevant

Wenn Gelb selektiret wird dann wird per Makro die Zelle Gelb

Grüße
falcon35
 
  • #4
also zu gut deutsch soll das makro auf den zelleninhalt die zelle einfärben

also wenn grün steht, grüner hintergrund

wenn - steht wird sie weiss usw...

korrekt?

// edit

das mit der gültigkeit versteh ich ebne net so ganz ^^ deshalb die nachfrage
 
  • #5
Hallo Billy_CH,

stimmt, genau so ist es.

Wenn grün steht dann wird der hintergrund grün.

Grüße
falcon35
 
  • #6
achso

ich dachte zuerst dass wenn irgend wo rot steht dann werden alle rot ^^

aber wenns so ist

bitte schön hoffe es hilft dir =)

Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
Dim bereich As String, max As Long, x As Long, start As Long, y As Long
bereich = C15:C25
start = ActiveSheet.Range(bereich).Row
max = ActiveSheet.Range(bereich).Row + ActiveSheet.Range(bereich).Rows.Count - 1
y = ActiveSheet.Range(bereich).Column
For x = start To max
 If LCase(Cells(x, y).Value) = gelb Then
  Cells(x, y).Interior.ColorIndex = 6
 ElseIf LCase(Cells(x, y).Value) = grün Then
  Cells(x, y).Interior.ColorIndex = 4
 ElseIf LCase(Cells(x, y).Value) = rot Then
  Cells(x, y).Interior.ColorIndex = 3
 ElseIf Cells(x, y).Value = - Then
  Cells(x, y).Interior.ColorIndex = 0
 ElseIf LCase(Cells(x, y).Value) = nicht relevant Then
  Cells(x, y).Interior.ColorIndex = 0
 ElseIf LCase(Cells(x, y).Value) =  Then
  Cells(x, y).Interior.ColorIndex = 0
 End If
Next
End Sub

nützt dir das ?
 
  • #7
Hallo Billy_CH,

leider verstehe ich den code nicht ganz, aber ich glaube ich habe fehl informationen am Anfang gegeben.

Das hier stimmt immer noch:
Abfrage:

Wenn in einer der Zeilen 15 bis 25 Rot ist dann Rot
Wenn in einer der Zeilen 15 bis 25 kein Rot und mindestens einmal gelb dann gelb
Wenn in einer der Zeilen 15 bis 25 kein Rot , kein gelb und mindestens einmal grün dann grün
Ansonsten Weiß

Die Abfrage die die Gültigkeit abprüft fehlt mir. Die Abfrage soll in Zeile 13 durchgeführt werden.

Grüße
falcon35
 
  • #8
ich komm nicht mehr nach

Matjes wird dir schon etwas weiterhelfen :)
 
  • #9
Hallo,

ich versuche die Erklärung meines Problems noch einmal zu beschreiben:

In der Zelle C13 soll die folgende Abfrage duchgeführt werden:

Wenn in einer der Zeilen C15 bis C25 Rot ist dann soll Zelle C13 auf jeden Fall rot sein.
Wenn in einer der Zeilen C15 bis C25 kein Rot und mindestens einmal gelb dann soll Zelle C13 auf jeden Fall gelb sein
Wenn in einer der Zeilen C15 bis C25 kein Rot , kein gelb und mindestens einmal grün dann soll Zelle C13 auf jeden Fall grün sein
Ansonsten Weiß

Ich hoffe das hilft weiter.

Für eure hilfe bin ich sehr dankbar.

Grüße
falcon35
 
  • #10
Hi zusammen,

eine Lösung könnte folgendermassen aussehen:
Code: 
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
  
  Const c_Bereich = C15:C25
  Const c_ZelleAusgabe = C13
  Const c_FarbeRot = Rot
  Const c_FarbeRotIndex = 3
  Const c_FarbeGelb = Gelb
  Const c_FarbeGelbIndex = 6
  Const c_FarbeGruen = Grün
  Const c_FarbeGruenIndex = 4
  
  Dim Zelle As Range, a As Long, z As Long, c As Long
  Dim l_ZeileAnf As Long, l_ZeileEnd As Long
  Dim l_SpalteAnf As Long, l_SpalteEnd As Long
  Dim l_FarbIndex As Long, s_Farbe As String
  
 ->Anfangs- und End-Zeile/Spalte des zu überwachenden Bereiches
  l_ZeileAnf = Range(c_Bereich).Row
  l_ZeileEnd = Range(c_Bereich).Row + Range(c_Bereich).Rows.Count - 1
  l_SpalteAnf = Range(c_Bereich).Column
  l_SpalteEnd = Range(c_Bereich).Column + Range(c_Bereich).Columns.Count - 1
  
 ->Zellen des geänderte Bereiches untersuchen
  For Each Zelle In Target
   ->schauen, ob die geänderte Zelle im überwachten Bereich liegt
    If Zelle.Row >= l_ZeileAnf And Zelle.Row <= l_ZeileEnd And _
      Zelle.Column >= l_SpalteAnf And Zelle.Column <= l_SpalteEnd Then
     ->-> Zelle im überwachten Bereich
      
     ->Bereich auf Farben untersuchen
     ->Reihenfolge Rot, Gelb, Gruen
      For a = 1 To 3
       ->gesuchte Farbe setzen
        If a = 1 Then
          l_FarbIndex = c_FarbeRotIndex
          s_Farbe = c_FarbeRot
        ElseIf a = 2 Then
          l_FarbIndex = c_FarbeGelbIndex
          s_Farbe = c_FarbeGelb
        ElseIf a = 3 Then
          l_FarbIndex = c_FarbeGruenIndex
          s_Farbe = c_FarbeGruen
        End If
        
        For z = l_ZeileAnf To l_ZeileEnd
          For c = l_SpalteAnf To l_SpalteEnd
            If Cells(z, c).Value = s_Farbe Then
             ->in einer Zelle im überwachten Bereich steht die Farbe
             ->-> Ausgabezelle -> Farbe
              Range(c_ZelleAusgabe).Interior.ColorIndex = l_FarbIndex
              Exit Sub->Farbe gesetzt -> Ende
            End If
          Next
        Next
      Next
     ->Da keine Farbe gesetzt wurde -> farblos setzen
      Range(c_ZelleAusgabe).Interior.ColorIndex = xlColorIndexNone
    End If
  Next
End Sub
Dieser Makro muß in der Code-Seite der Tabelle liegen.

Die in den Konstanten definierten FarbIndexe für die Färbung der Zelle C13 können angepasst werden.

Um die Farbindexe sichtbar zu machen, kannst Du folgendes Makro benutzen. Es erzeugt eine neue Mappe und gibt in dieser die Farben und die dazugehörigen Farbindexe aus.
Code: 
Sub DemonstrateColorIndex()
'Darstellung der 56 ColorIndex-Farben
Dim c As Integer, r As Integer, i_ColorIndex As Integer
  Workbooks.Add
  For c = 1 To 6
    For r = 1 To 10
      i_ColorIndex = (c - 1) * 10 + r
      With ActiveSheet.Cells(r, c)
        .Value = i_ColorIndex
        .Interior.ColorIndex = i_ColorIndex
        .HorizontalAlignment = xlCenter
      End With
      If i_ColorIndex >= 56 Then Exit Sub
    Next
  Next
End Sub

Gruß Matjes  :)
 
  • #11
Hallo Matjes,

vielen Dank!!

Funktioniert genau so wie ich es mir vorgestellt habe.

Grüße
falcon35
 
Thema:

Bedingte Formatierung mit Farben

ANGEBOTE & SPONSOREN

Neueste Themen

Statistik des Forums

Themen
113.839
Beiträge
707.962
Mitglieder
51.492
Neuestes Mitglied
Janus36
Oben