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