|
Wo ist denn das problem?
Sub aktuellesQuartal()
Dim Q As Variant
On Error Resume Next
' B-D & W-X grün färben für aktuelles Quartal sonst grau
Sheets("SOP Gmbh").Select
quartal:
Q = Val(InputBox("Welches Quartal?"))
If Val(Q) < 0 Or Val(Q) > 4 Then
MsgBox ("Ungültiger Wert"): GoTo quartal
End If
For zeile = 3 To 86
If Q = ActiveSheet.Cells(zeile, 1).Value Then
Union(Range("B" & zeile & ":" & "F" & zeile), Range("H" & _
zeile, "I" & zeile), Range("K" & zeile, "L" & zeile), Range("N" & _
zeile, "O" & zeile), Range("Q" & zeile, "R" & zeile), Range("T" & _
zeile, "U" & zeile), Range("W" & zeile, "X" & zeile)).Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 5296274
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Else
Union(Range("B" & zeile & ":" & "F" & zeile), Range("H" & _
zeile, "I" & zeile), Range("K" & zeile, "L" & zeile), Range("N" & _
zeile, "O" & zeile), Range("Q" & zeile, "R" & zeile), Range("T" & _
zeile, "U" & zeile), Range("W" & zeile, "X" & zeile)).Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorDark1
.TintAndShade = -0.499984740745262
.PatternTintAndShade = 0
End With
End If
Next zeile
End Sub
Übrigens: "Int(Format(Date, "Q"))" ist quatsch, da "Format(Date, "Q")" sowieso immer eine ganzzahl ist.
Ausserdem kann man den Autoformat statt multiselect für mehrere ranges nehmen, d.h. die gleiche regel mehrmals eingeben, aber jeweils anderer bereich.
|