Hi Fritz,
nette Finderübung
Sub BedingtesFormatierenMitMacroErstellen()
Rem *******************************************
Rem statt For Next über Rangeobjekte definieren
Rem *******************************************
Rem Festlegungen für variable Verwendung
Const begRow As Long = 2 'Beginne ab Zeile 2
Const fstCol As Long = 1 'Erste Spalte wo formatiert [A:A]
Const nxtCol As Long = 3 'Anzahl Spalten daneben somit [D:D]
Const Muster As String = "=ANZAHL2($E$1:$U$1) = 0" 'Musterformel
Rem die Spalten dazu nach der Musterformel
Const fraCol As Long = 4 'Anzahl Spalten daneben wo Formelbereich beginnt [E:E]
Const freCol As Long = 20 'Anzahl Spalten daneben wo Formelbereich zu Ende [U:U]
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 'Tabelle durchlaufen
Dim bRng As Range 'Bereich wo bedingt formatiert
Dim vRng As Range 'Bereich wo Formel für
Dim c As Range 'aktueller Bereich
Dim fStr As String 'für Musterformel
Dim lstRow As Long 'bis letzte Zeile
Dim IntCol As Long 'Farbwert
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 'Standard
Next c
Rem Fertig
End Sub
|