Bedingte Formatierung via Makro

[Rolf Beißner]

Hallo Forum,

in einer Kalender-Tabelle (siehe beigef. Arbeitsmappe) sind Zahltermine markiert.
Nun soll per bedingter Formatierung das Tagesdatum und der nächste Zahltermin andersfarbig markiert werden.
Das funktioniert bei manueller Eingabe.
Bei Nutzung des entsprechenden Makros wird der nächste Zahltermin nicht markiert.

Für einen Hinweis auf die mögliche Fehlerursache wäre ich sehr dankbar.

MfG
Rolf Beißner

[Kuwer]

Hi Rolf,

so klappt es bei mir:

Code:

Option Explicit

Dim bolInstall As Boolean

'Tagesdatum einfärben via bedingter Formatierung für heute(grün) und nächste Zahlung (rot)
Sub markDates()
    Dim Bereich As Range, feld As Range
    Dim n As Long
    Dim strFormatCondition As String
    
    n = Range("B" & Rows.Count).End(xlUp).Row
    Set Bereich = Range("C2:I" & n)
    With Bereich
        .FormatConditions.Delete
        .FormatConditions.Add Type:=xlExpression, Formula1:="=C2=HEUTE()"
        .FormatConditions(1).Interior.Color = vbGreen
        bolInstall = True
        .FormatConditions.Add Type:=xlExpression, Formula1:="=C2=HEUTE()+DPLUS()"
        .FormatConditions(2).Interior.Color = vbRed
        bolInstall = False
        .Calculate
    End With
End Sub

'Anzahl der Tage bis zur nächsten Zahlung
Function DPLUS()
    Dim Bereich As Range, feld As Range
    Dim n As Long
    
    If bolInstall Then Exit Function
    
    n = Range("B" & Rows.Count).End(xlUp).Row
    Set Bereich = Range("C2:I" & n)
    
    For Each feld In Bereich
        If feld.Value > Date And feld.Interior.ColorIndex >= 40 Then
            DPLUS = feld.Value - Date
            Exit For
        End If
    Next
End Function

'Bedingte Formatierungen löschen
Sub deleteFormatConditions()
    Cells.FormatConditions.Delete
End Sub

Gruß Uwe

[Rolf Beißner]

Hi Uwe,

geniale Lösung. Ich bin begeistert.
Ganz herzlichen Dank.

Viele Grüße
Rolf

PS
Kennen wir uns aus einem anderen Forum?

[Kuwer]

Hi Rolf,

Kennen wir uns aus einem anderen Forum?

ja, Thema "Verbuschung". 

Gruß Uwe

[Rolf Beißner]

Hi Uwe,

danke für den Tipp.
Mir fällt da eher ein Sommertag auf dem Rhein ein (ten years ago?)

Herzl Grüße
Rolf

[Kuwer]

Hi Rolf,

11 Jahre ist es her. 

   

Gruß Uwe