|
Hallo
ungetestet...!
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Bereich1 As Range
Dim Bereich2 As Range
Dim Zelle As Range
Set Bereich1 = Range("W8:W100")
Set Bereich2 = Range("X8:X100")
If Not Intersect(Target, Bereich1) Is Nothing Then
For Each Zelle In Bereich1
Select Case Zelle.Value
Case "x": Zelle.Interior.ColorIndex = xlNone
Case Is < Cells(5, 23) - Cells(4, 23): Zelle.Interior.ColorIndex = 3
Case Cells(5, 23) - Cells(4, 23) To Cells(5, 23) * 0.95: Zelle.Interior.ColorIndex = 45
Case Cells(5, 23) * 0.95 To Cells(5, 23) * 1.05: Zelle.Interior.ColorIndex = 43
Case Cells(5, 23) * 1.05 To Cells(5, 23) + Cells(4, 23): Zelle.Interior.ColorIndex = 50
Case Is > Cells(5, 23) + Cells(4, 23): Zelle.Interior.ColorIndex = 33
Case Else
Zelle.Interior.ColorIndex = xlNone
End Select
Next
End If
If Not Intersect(Target, Bereich2) Is Nothing Then
For Each Zelle In Bereich2
Select Case Zelle.Value
Case "x": Zelle.Interior.ColorIndex = xlNone
Case Is < Cells(5, 24) - Cells(4, 24): Zelle.Interior.ColorIndex = 3
Case Cells(5, 24) - Cells(4, 24) To Cells(5, 24) * 0.95: Zelle.Interior.ColorIndex = 45
Case Cells(5, 24) * 0.95 To Cells(5, 24) * 1.05: Zelle.Interior.ColorIndex = 43
Case Cells(5, 24) * 1.05 To Cells(5, 24) + Cells(4, 24): Zelle.Interior.ColorIndex = 50
Case Is > Cells(5, 24) + Cells(4, 24): Zelle.Interior.ColorIndex = 33
Case Else
Zelle.Interior.ColorIndex = xlNone
End Select
Next
End If
End Sub
MfG Tom
|