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.
|