Hallo, guten Morgen ....
ich weiss nicht ob elegant oder nicht - aber es funktioniert.
Musste nur einige Kleinigkeiten ändern.
Der Code sieht nun so aus:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Y As Integer
Dim X As Integer
Dim RaBereich As Range
Dim RaZelle As Range
Set RaBereich = Range("C5:EZ32")
Set RaBereich = Intersect(RaBereich, Range(Target.Address))
If Not RaBereich Is Nothing Then
For Each RaZelle In RaBereich
With RaZelle
Y = Target.Row ' aktuelle Zeilennummer
X = Target.Column ' aktuelle Spaltennummer merken
If RaZelle = "x" And Cells(5, X) = "SR" Then
.Interior.Color = RGB(255, 128, 128)
ElseIf RaZelle = "x" And Cells(5, X) = "PH" Then
.Interior.Color = RGB(204, 128, 255)
ElseIf RaZelle = "x" And Cells(5, X) = "SK" Then
.Interior.Color = RGB(51, 204, 204)
ElseIf RaZelle = "x" And Cells(5, X) = "AW" Then
.Interior.Color = RGB(255, 255, 153)
ElseIf RaZelle = "x" And Cells(5, X) = "RLB" Then
.Interior.Color = RGB(255, 204, 0)
ElseIf RaZelle = "x" And Cells(5, X) = "AH" Then
.Interior.Color = RGB(150, 150, 150)
ElseIf RaZelle = "x" And Cells(5, X) = "SP" Then
.Interior.Color = RGB(0, 255, 255)
Else
.Interior.ColorIndex = xlNone
End If
End With
Next RaZelle
End If
Set RaBereich = Nothing
End Sub
Vielen Dank für die Hilfe
Gruss Petra