06.07.2018, 10:29
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:
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