Aktualisierung von Formeln

[Runpoint86]

Hallo Zusammen,

ich habe mir eine Formel zur Zählung von farbigen Zellen in mein Excel (als Modul) gepackt. Hiermit bin ich eigentlich wunderbar in der Lage jede farbige Zelle zu unterscheiden und zu zählen. Das Problem das ich nun habe...wenn ich in dem Bereich den ich betrachte eine Zellenfarbe ändere, ändert sich das Ergebnis der Formel nicht. Ich muss noch einmal aktiv in meine Berechnungszelle reingehen und auf Enter klicken. Natürlich soll diese aber immer dynamisch direkt mitzählen...kann mir einer hierbei helfen? Aktualisierung der Formeln ist unter Optionen auf automatisch eingestellt. Der Code der Formel ist im folgenden zu sehen:

Code:

Public Function ZählenWennFormat(Bereich As Range, _
                                 ReferenzZelle As Range, _
                                 Optional ZellenFarbe As Boolean = True, _
                                 Optional ZellenMuster As Boolean = False, _
                                 Optional SchriftFarbe As Boolean = False, _
                                 Optional SchriftFett As Boolean = False, _
                                 Optional SchriftKursiv As Boolean = False) _
                                 As Variant

    '© t.ramel@mvps.org, 26.08.2009
    'Funktion zur Anwendung von ZÄHLENWENN() mit Hintergrund-,
    'Schriftfarbe, Fett, Kursiv als Zählkriterium
    'Beliebig erweiterbar um weitere Kriterien
    '
    'Die Parametereingabe erfolgt in derselben Reihenfolge
    'wie in der Funktion ZÄHLENWENN():
    ' - Der erste Parameter erwartet den Suchbereich
    ' - Der zweite Parameter erwartet einen Zellbezug der als Kriterium
    '   verwendet wird - die einzelnen Formate werden aus dieser Zelle ermittelt
    ' - Der dritte Parameter erwartet Wahr/Falsch für die Hintergrund-Farbe
    ' - Der vierte Parameter erwartet Wahr/Falsch für die Schrift-Farbe
    ' - Der fünfte Parameter erwartet Wahr/Falsch für fette Schrift
    ' - Der sechste Parameter erwartet Wahr/Falsch für kursive Schrift

    'Zur automatischen Aktualisierung im Tabellenblatt den folgenden Term
    'anhängen: +(0*JETZT()) und durch F9 drücken die Funktion aktualisieren
    'Also z.B. wie folgt: =ZählwenWennFormat(A1:A10;A1)+(0*JETZT())

Dim lngI                 As Long
Dim varWerte             As Variant
Dim varKrit1             As Variant
Dim varKrit2             As Variant
Dim Anzahl               As Long


    If Bereich.Rows.Count > 1 And Bereich.Columns.Count > 1 Then
        ZählenWennFormat = CVErr(xlErrRef)
        Exit Function
    End If

    ReDim varWerte(1 To Bereich.Count)

    'Prüfen auf die Farbe der Zelle
    If ZellenFarbe Then
        varKrit1 = ReferenzZelle(1).Interior.ColorIndex
        For lngI = 1 To Bereich.Count
            If Bereich(lngI).Interior.ColorIndex <> varKrit1 Then
                varWerte(lngI) = 0
            End If
        Next
    End If

    'Prüfen auf das Muster der Zelle
    If ZellenMuster Then
        varKrit1 = ReferenzZelle(1).Interior.Pattern
        varKrit2 = ReferenzZelle(1).Interior.PatternColorIndex
        For lngI = 1 To Bereich.Count
            If (Bereich(lngI).Interior.Pattern <> varKrit1) Or _
               (Bereich(lngI).Interior.PatternColorIndex <> varKrit2) Then
                varWerte(lngI) = 0
            End If
        Next
    End If

    'Prüfen auf die Farbe der Schrift
    If SchriftFarbe Then
        varKrit1 = ReferenzZelle(1).Font.ColorIndex
        For lngI = 1 To Bereich.Count
            If Bereich(lngI).Font.ColorIndex <> varKrit1 Then
                varWerte(lngI) = 0
            End If
        Next
    End If

    'Prüfen auf fette Schrift
    If SchriftFett Then
        varKrit1 = ReferenzZelle(1).Font.Bold
        For lngI = 1 To Bereich.Count
            If Bereich(lngI).Font.Bold <> varKrit1 Then
                varWerte(lngI) = 0
            End If
        Next
    End If

    'Prüfen auf kursive Schrift
    If SchriftKursiv Then
        varKrit1 = ReferenzZelle(1).Font.Italic
        For lngI = 1 To Bereich.Count
            If Bereich(lngI).Font.Italic <> varKrit1 Then
                varWerte(lngI) = 0
            End If
        Next
    End If

    ZählenWennFormat = Bereich.Count - WorksheetFunction.Count(varWerte)

End Function

[Peter]

Hallo,

die Antwort hat doch Thomas schon in den Kommentar zum Code geschrieben:

Zur automatischen Aktualisierung im Tabellenblatt den folgenden Term
'anhängen: +(0*JETZT()) und durch F9 drücken die Funktion aktualisieren
'Also z.B. wie folgt: =ZählwenWennFormat(A1:A10;A1)+(0*JETZT())

[Runpoint86]

Oh.....tatsächlich...bin mal gar nicht dran gewöhnt, dass jemand derart gut kommentiert:)
Danke für den Hinweis