|
Hallo, ich verzweifle ein wenig. Ich möchte in einem Tabellenblatt für jede Spalte andere Select Case Bedingungen festhalten. Hier mein Vorschlag:
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, Bereich2) 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
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
Es wirft zwar keinen Fehler aus, aber es tut sich auch nichts. Die Zellen werden nicht gefärbt. Habe auch schon mit Private Sub Worksheet_Calculate() versucht. Da bekomme ich dann einen Laufzeitfehler 424.
|