Supportnet Computer
Planet of Tech

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:

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