Farbe der Zelle abhängig vom Wert

[Buddha]

Hallo,

ich habe Stunden damit verbracht mein Makro/VBA-Problem zu lösen, aber es funktioniert noch immer nicht zufriedenstellend. Vorweg: Ich bin ein absoluter VB-Frischling und habe mithilfe von Internet-Recherche etwas zustande gebracht.

Ich habe pro Zelle innerhalb einer Spalte Werte um ><1.0. Ich möchte, dass sich der Zellenhintergrund, je weiter der Wert von 1.0 abweicht, von Grün über Gelb, Orange bis hin zu Rot in beide Richtungen verfärbt. Grenze ist dabei so 0.5 bzw. 1.5. Mein Problem ist vor allem, dass im Tabellenblatt die Änderungen, die ich im Visual Basic Programmcode-Fenster vornehme gar nicht sofort angezeigt werden. Wenn ich z.B. Farbtöne ändere und die Zelle aktualisiere, bleibt sie trotzdem in der gleichen Farbe. Wie kann das sein!? Auch scheint der Code vllt fehlerhaft, da manche Farben gar nicht abgebildet werden, obwohl diese aufgrund der Werte sich eigentlich ändern müssten (Gelb und Hellrot).

Hier ist der Code:

Code:

Private Sub Worksheet_Change(ByVal Target As Range)
   Dim rngC As Range
   If Not Intersect(Target, Range("AQ5:AQ282")) Is Nothing Then
      For Each rngC In Range("AQ5:AQ282")
         Select Case True
            Case Not IsNumeric(rngC.Value) Or Trim(rngC.Value) = ""
               rngC.Interior.ColorIndex = xlColorIndexNone 'keine Färbung
            Case rngC.Value = 0.9 To 1.1
               rngC.Interior.ColorIndex = 4 'grün
            Case rngC.Value = 0.8 To 0.9
               rngC.Interior.ColorIndex = 3 'hellgrün
            Case rngC.Value = 0.7 To 0.8
               rngC.Interior.ColorIndex = 6 'gelb
            Case rngC.Value = 0.6 To 0.7
               rngC.Interior.ColorIndex = 45 'orange
            Case rngC.Value = 0.5 To 0.6
               rngC.Interior.ColorIndex = 46 'hellrot
            Case rngC.Value < 0.5
               rngC.Interior.ColorIndex = 3 'rot
            Case rngC.Value = 1.1 To 1.2
               rngC.Interior.ColorIndex = 3 'hellgrün
            Case rngC.Value = 1.2 To 1.3
               rngC.Interior.ColorIndex = 6 'gelb
            Case rngC.Value = 1.3 To 1.4
               rngC.Interior.ColorIndex = 45 'orange
            Case rngC.Value = 1.4 To 1.5
               rngC.Interior.ColorIndex = 46 'hellrot
            Case rngC.Value > 1.5
               rngC.Interior.ColorIndex = 3 'rot
         End Select
      Next
   End If
End Sub

Könnt ihr mir bitte weiterhelfen?
Die Farben der Zellen sollen sich bestenfalls sofort ändern, wenn sich die Werte verschieben...

Vielen Dank im voraus!!

[RPP63]

Moin!
Warum überhaupt VBA?
Nimm eine Farbskala aus der bedingten Formatierung.
   

Gruß Ralf

[RPP63]

Ich sehe gerade, dass Du ja den Abstand zu 1 bewerten willst.
Ohne VBA sehe ich hier nur die Möglichkeit, den Betrag des Abstands mittels Hilfsspalte darzustellen:
=ABS(A1-1)
und auf diese Hilfsspalte die Farbskala anzuwenden.

Gruß Ralf

[Buddha]

Ich sehe gerade, dass Du ja den Abstand zu 1 bewerten willst.
Ohne VBA sehe ich hier nur die Möglichkeit, den Betrag des Abstands mittels Hilfsspalte darzustellen:
=ABS(A1-1)
und auf diese Hilfsspalte die Farbskala anzuwenden.

Gruß Ralf

Ich weiß nicht genau, wie du das meinst...
Könntest du das etwas ausführlicher erläutern?

Die Farbskala an sich ist schon mal gut. Wenn es mit VBA irgendwie geht, hätte da jemand eine Lösung?

Grüße

[RPP63]

Ich habe Dir mal flugs ein Beipiel gebastelt.
Mittels F9 kannst Du mittels Neuberechnungen das Aussehen aktualisieren.

[Buddha]

Danke für die Lösung!

Damit könnte ich leben. Falls jemandem noch eine VBA-Möglichkeit einfällt, würde ich das auch gerne mal probieren, da man dann keine Hilfsspalte bräuchte...

[Käpt'n Blaubär]

Hallo,

 würde ich das auch gerne mal probieren, da man dann keine Hilfsspalte bräuchte...

... stimmt nicht. hab ich auch schon einmal in meinem VBA-Leben einsetzen müssen  :05:

stimmt auch nicht, wenn ich richtig in mich gehe, kommt das reichlich oft vor.
Alleine schon dann, wenn mit Variablen jongliert werden muß, geht's nicht ohne.

[Kuwer]

Hallo Buddha,

Private Sub Worksheet_Change(ByVal Target As Range)
   Dim rngC As Range
   If Not Intersect(Target, Range("AQ5:AQ282")) Is Nothing Then
      For Each rngC In Range("AQ5:AQ282")
        rngC.Interior.ColorIndex = Choose(Application.RoundDown(Abs(1 - rngC.Value) * 10, 0) + 1, 4, 43, 6, 45, 46, 3)
      Next
   End If
End Sub

Gruß Uwe