AW: Ausgewählte Zelle immer farbig markieren
10.05.2006 20:22:14
Matze
Hallo Harald,
hier ein kleines Beispiel welches ich selber einsetze (es wird die Spalte F durchsucht und eingefärbt):
Private Sub Worksheet_Change(ByVal Target As Range)
Dim intEnde As Integer
Dim L As Integer
Application.ScreenUpdating = False
If Target.Column = 6 Then
'Diese Pruefung auf den relevanten Datenbereich erweitern
intEnde = Cells(Rows.Count, 2).End(xlUp).Row
' Spalte B durchzaehlen, da hier die meisten Werte
For L = 5 To intEnde
' Zellen gem. Risiko einfaerben
If Worksheets("Übersicht").Cells(L, 6).Value = 1 Then
Worksheets("Übersicht").Cells(L, 6).Interior.ColorIndex = 5
' Risikoeinstufung blau
End If
If Worksheets("Übersicht").Cells(L, 6).Value = 2 Then
Worksheets("Übersicht").Cells(L, 6).Interior.ColorIndex = 4
' Risikoeinstufung gruen
End If
If Worksheets("Übersicht").Cells(L, 6).Value = 3 Then
Worksheets("Übersicht").Cells(L, 6).Interior.ColorIndex = 6
' Risikoeinstufung gelb
End If
If Worksheets("Übersicht").Cells(L, 6).Value = 4 Then
Worksheets("Übersicht").Cells(L, 6).Interior.ColorIndex = 46
' Risikoeinstufung orange
End If
If Worksheets("Übersicht").Cells(L, 6).Value = 5 Then
Worksheets("Übersicht").Cells(L, 6).Interior.ColorIndex = 3
' Risikoeinstufung rot
End If
If Worksheets("Übersicht").Cells(L, 6).Value > 5 Then
Worksheets("Übersicht").Cells(L, 6).Interior.ColorIndex = xlColorIndexNone ' keine Farbe
End If
Next L
End If
Application.ScreenUpdating = True
End Sub
mfg Matze