Sub
BedingtesFormatierenMitMacroErstellen()
Rem *******************************************
Rem statt
For
Next
über Rangeobjekte definieren
Rem *******************************************
Rem Festlegungen für variable Verwendung
Const
begRow
As
Long
= 2
Const
fstCol
As
Long
= 1
Const
nxtCol
As
Long
= 3
Const
Muster
As
String
=
"=ANZAHL2($E$1:$U$1) = 0"
Rem die Spalten dazu nach der Musterformel
Const
fraCol
As
Long
= 4
Const
freCol
As
Long
= 20
Rem die Farbe - hier Gelb
Const
mRed
As
Integer
= 255
Const
mGre
As
Integer
= 255
Const
mBlu
As
Integer
= 0
Rem die Variablen
Dim
aRng
As
Range
Dim
bRng
As
Range
Dim
vRng
As
Range
Dim
c
As
Range
Dim
fStr
As
String
Dim
lstRow
As
Long
Dim
IntCol
As
Long
Rem vorhandene Formatierungen löschen
Cells.FormatConditions.Delete
Rem von begRow bis lstRow
lstRow = Cells.Find(
"*"
, [A1], , , xlByRows, xlPrevious).Row
Rem Spalte A von [A2] nach unten
Set
aRng = Range(Cells(begRow, fstCol), Cells(lstRow, fstCol))
Rem Farbwert
IntCol = RGB(mRed, mGre, mBlu)
Rem jetzt ab nach unten
For
Each
c
In
aRng
Rem Bereich für die Formel in der Zeile
Set
vRng = Range(c.Offset(0, fraCol), c.Offset(0, freCol))
Rem Bereich wo bedingt formatiert
Set
bRng = Range(c, c.Offset(0, nxtCol))
Rem Musterformel in Variable
fStr = Muster
Rem Austausch mit akt. Wert
fStr = Replace(fStr,
"$E$1:$U$1"
, vRng.Address)
Rem Bereich wo bedingt formatiert versorgen
bRng.FormatConditions.Add Type:=xlExpression, Formula1:=fStr
bRng.FormatConditions(bRng.FormatConditions.Count).SetFirstPriority
With
bRng.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.Color = IntCol
.TintAndShade = 0
End
With
bRng.FormatConditions(1).StopIfTrue =
True
Next
c
Rem Fertig
End
Sub