Supportnet / Forum / Skripte(PHP,ASP,Perl...)
Zellen in def. Bereich in Abhängigkeit von Zahlen färben
Frage
Hallo zusammen,
bestimmt kann mir jemand von Euch weiterhelfen!
Unten ist ein Makro abgebildet, bei dem definiert werden kann wie sich die Zelle im Tabellenblatt bei Eingabe einer bestimmten Zahl färben soll. So kann z. B. definiert werden, dass sich eine Zelle automatisch rot einfärbt (Case 3 Target.Interior.ColorIndex = 3), wenn ein bestimmter Wert (in dem Fall 3) eingegeben wird.
* 1 - Schwarz
* 2 - Weiss
* 3 - Rot
* 4 - Grün
* 5 - Blau
* 6 - Gelb
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Select Case Target.Value
Case 1
Target.Interior.ColorIndex = 1
Case 2
Target.Interior.ColorIndex = 2
Case 3
Target.Interior.ColorIndex = 3
Case 4
Target.Interior.ColorIndex = 4
Case 5
Target.Interior.ColorIndex = 5
Case 6
Target.Interior.ColorIndex = 6
Case Else
Target.Interior.ColorIndex = xlColorIndexNone
End Select
End Sub
Ich benötige das Makro in folgender Form:
„kleiner/gleich“ 5% = grün (4)
„größer/gleich“ -5% = grün (4)
„kleiner/gleich“ 8% = gelb (6)
„größer/gleich“ -8% = gelb (6)
„größer als“ 8% = rot (3)
„kleiner als“ -8% = rot (3)
... und das ganze für die Zellen "A1:A20" und "D1:D20"
Vielen Dank für Eure Antworten
Gruß
Sascha
Antwort 1 von Bert
Hallo
Hoffe es tut das was Du willst:
Gruß Bert
Hoffe es tut das was Du willst:
Option Explicit
Private Sub Worksheet_Calculate()
Rem Für berechnete Werte
Dim r As Integer, c As Integer
Rem für die Bereiche "A1:A20" und "D1:D20"
For r = 1 To 4 Step 3
For c = 1 To 20
Select Case Abs(Cells(c, r).Value)
Case 0
Cells(c, r).Interior.ColorIndex = 0: Rem Neutral
Case 0.05
Cells(c, r).Interior.ColorIndex = 4: Rem grün
Case 0.05 To 0.08
Rem Wert =8% oder -8%
Cells(c, r).Interior.ColorIndex = 6: Rem Gelb
Case Is > 0.08
Rem Wert > + -8%
Cells(c, r).Interior.ColorIndex = 3: Rem Rot
Case Else
Rem Wert ist kleiner/gleich 5%
Cells(c, r).Interior.ColorIndex = 4: Rem grün
End Select
Next: Next
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
Rem auf zuläßige Bereiche prüfen
If Target.Row > 20 Or Target.Column > 4 Then Exit Sub
Rem Wenn zeile>20 oder Spalte >4 prog verlassen
If Target.Column = 2 Or Target.Column = 3 Then Exit Sub
Rem Wenn spalte =2("B") oder Spalte =3 ("C") prog verlassen
Select Case Abs(Target.Value)
Case 0
Target.Interior.ColorIndex = 0: Rem Neutral
Case 0.05
Target.Interior.ColorIndex = 4: Rem grün
Case 0.05 To 0.08
Rem Wert =8% oder -8%
Target.Interior.ColorIndex = 6: Rem Gelb
Case Is > 0.08
Rem Wert > + -8%
Target.Interior.ColorIndex = 3: Rem Rot
Case Else
Rem Wert ist kleiner/gleich 5%
Target.Interior.ColorIndex = 4: Rem grün
End Select
End Sub
Gruß Bert