Format in zwei Spalten mittels Intersect ändern
04.10.2013 12:45:57
Christian
nicht lang ists her - aber ich stehe wieder auf dem Schlauch =)
Ich habe folgenden Code geschrieben, der leider nicht das gewünschte Ergebnis bringt. Ich ahne zwar warum - aber ein aufsplitten in zwei Intersect Befehle brachte auch nicht die gewünschten Ergebnisse.
Es soll wenn sich der Wert in Spalte C oder D ändert das Format angepasst werden. Hier erwähne ich direkt, dass sich aktiv immer nur Spalte D ändert. Spalte C ist eine Formel die den Status per Wenn Formel in Bezug auf Spalte D verändert.
Ändern tut sich aber immer nur der aktiv veränderte Wert in Spalte D.
Wie bekomme ich nun eine Doppeländerung hin?
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
'Bei Änderungen am Status wird das Format geändert
Dim rc As Range
Application.ScreenUpdating = True
If Not Intersect(Target, Range("C3:D200")) Is Nothing Then
For Each rc In Intersect(Target, Range("C3:D200")).Cells
With rc
Select Case .Value
'Änderungen in Spalte C - Laufende Aktion
Case "aktiv"
'Farbe Gelb
.Font.ColorIndex = 1
.Font.Name = "Vorgabe Sans Serif"
.Interior.Color = RGB(255, 255, 0)
'.Font.Size = 10
Case "fertig"
'Farbe grün
.Font.ColorIndex = 1
.Font.Name = "Vorgabe Sans Serif"
.Interior.Color = RGB(0, 176, 80)
'.Font.Size = 10
Case "error"
'Farbe rot
.Font.ColorIndex = 1
.Font.Name = "Vorgabe Sans Serif"
.Interior.Color = vbRed
'.Font.Size = 10
Case "-"
'Farbe grau
.Font.ColorIndex = 1
.Font.Name = "Vorgabe Sans Serif"
.Interior.Color = RGB(216, 216, 216)
'.Font.Size = 10
'Änderungen in Spalte D - Laufender Status
Case "Start nicht möglich"
'Farbe rot
.Font.ColorIndex = 1
.Font.Name = "Vorgabe Sans Serif"
.Interior.Color = vbRed
'.Font.Size = 10
Case "Start erfolgt"
'Farbe Gelb
.Font.ColorIndex = 1
.Font.Name = "Vorgabe Sans Serif"
.Interior.Color = RGB(255, 255, 0)
'.Font.Size = 10
Case "abgeschlossen"
'Farbe Gelb
.Font.ColorIndex = 1
.Font.Name = "Vorgabe Sans Serif"
.Interior.Color = RGB(0, 176, 80)
'.Font.Size = 10
End Select
End With
Next rc
End If
End Sub
End Sub
Gruß
Christian