[Excel] Bedingte Formatierung in VBA - Frage

[Lubber]

Hallo,

ich würde gerne mehrere Bedigungen in Excel zur Formatierung nutzen, daher ein VBA Script, Excel lässt ja leider nur 3 über die normale Funktion zu.

Aufgabe:
Wert aus Zelle XY vergleichen mit Bedignung = oder >= oder <= Wert und Färbung der Zelle in Farbe Z.

Was ich bisher habe:

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Select Case Target.Value

Case ">=80"
Target.Interior.ColorIndex = 4

Case Else
Target.Interior.ColorIndex = xlColorIndexAutomatic
End Select
End Sub

Mein Problem 'Case ">=80" ' scheint nicht zu funktionieren da Case wohl nur auf den exakten Wert anspricht, wie bekomme ich also eine größer Gleich Funktion in die Abfrage?

 

[Mr. Snoot]

Case Is >=80 sollte es tun (keine "").

 

[Lubber]

Ich hab rausgefunden, dass

Case Is >= 0, 8

für 80% funktioniert.

Wie bekomme ich denn nun folgendes hin:

Case Is = 1, 0
Target.Interior.ColorIndex = 4
Case Is <= 1, 0
Target.Interior.ColorIndex = 6
Case Is <= 0, 75
Target.Interior.ColorIndex = 8

Der Case Is <= 0,75 wird nicht mehr beachtet alles unter 100% wird Gelb (6) gefärbt.

Lösche ich eine Zelle wird die übrigens grün (4) und ich bekomme einen Laufzeitfehler 13, Typen unverträglich für die erste Case Is = 1, 0 Zeile.

Bisher:

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Select Case Target.Value
Case Is = 1, 0
Target.Interior.ColorIndex = 4
Case Is <= 1, 0
Target.Interior.ColorIndex = 36
Case Is <= 0, 75
Target.Interior.ColorIndex = 6
Case Is < 0, 1
Target.Interior.ColorIndex = 7
Case Else
Target.Interior.ColorIndex = xlNone
End Select
End Sub

Allerdings sorgt

Case Is < 0, 1
Target.Interior.ColorIndex = 7

dafür, dass auch Zellen mit 0 oder anderen Werten erfasst werden gibt es ein Case ist < X bis > Y.

 

[Mr. Snoot]

Da musst du die Reihenfolgen beachten.

Wenn Case Is <= 1 eintritt, dann wird nichts weiter ausgeführt - Case Is <=0.75 kommt also gar nicht zum Zuge.


Außerdem ist deine Schreibweise sehr merkwürdig. Dezimalzahlen musst du mit Punkt schreiben und ohne Leerzeichen (0, 75 -> 0.75). Da sollte aber eigentlich auch ein Fehler kommen.

 

[Lubber]

Es kam kein Fehler Excel hat es einfach ignoriert.

Ich bin jetzt soweit das richtig farblich hinterlegt wird, allerdings habe ich die Fehlermeldung von oben immernoch bei Case Is = 1 wenn ich z.B. mehrere Zeilen in die Mappe kopiere.

Auch ein "Autocolor" bei vorhandenen Werten wäre toll. Das Problem ist nämlich die Tabelle hat keine Formeln nur fixe Werte, ich hab nämlich die Warscheinlichkeitsberechnung für Würfel mit 6 Seiten bei X Erfolgen und Mindestwurf Y (6 wird hochgewürfelt auf 7-12 etc.) nicht und daher einfach eine freie Tabelle aus dem Netz genommen und die Werte in Excel gepackt.

Ich häng die mal an.

Das ist übrigens soweit der Code der auch farblich funktioniert nur die Tabelle nicht färben will und bei copy & paste Fehler produziert. Einzeleingaben gehen. Ich glaube auch der Zellbereich ist suboptimal aber ich hab von VBA mal null Ahnung.

Private Sub Worksheet_Change(ByVal Target As Range)

Dim Zellbereich As Range
Set Zellbereich = Range("A1:Z500")
If Intersect(Target, Zellbereich) Is Nothing Then
  Exit Sub
Else
Select Case Target
Case Is = 1#
Target.Interior.ColorIndex = 4
Case Is < 0.01
Target.Interior.ColorIndex = 3
Case Is < 0.25
Target.Interior.ColorIndex = 46
Case Is < 0.5
Target.Interior.ColorIndex = 36
Case Is <= 0.75
Target.Interior.ColorIndex = 6
Case Is < 1#
Target.Interior.ColorIndex = 35
Case Else
Target.Interior.ColorIndex = xlNone
End Select
End If
End Sub

Ich hab einen funktionierenden Code gefunden der "bei Klick" die Farbe ändert. Geht das auch wenn man eine Vielzahl von Zellen markiert? Leider wirft er mir da einen Fehler aus.

Laufzeitenfehler '13': Typen unverträglich

Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
Select Case Target.Value
Case Empty
Target.Interior.ColorIndex = xlNone
Case Is < 0.05
Target.Interior.ColorIndex = 3
Case Is < 0.2
Target.Interior.ColorIndex = 46
Case Is < 0.4
Target.Interior.ColorIndex = 6
Case Is < 0.6
Target.Interior.ColorIndex = 36
Case Is <= 0.8
Target.Interior.ColorIndex = 35
Case Is <= 1#
Target.Interior.ColorIndex = 4
End Select
End Sub