Function ZählenWennFarbe(varColor As Variant, rngBereich As Range, _
Optional bolFont As Boolean = False) As Double
'Idee von Melanie Breden, erweitert von Thomas Ramel / 13.10.2004
'Funktion zur Anwendung von ZÄHLENWENN mit Hintergrundfarbe
'oder Schriftfarbe als Kriterium
' - Der erste Parameter erwartet einen Zellbezug (Hintergrund/Schriftfarbe)
' oder Farbindex (Zahl)
' Farbindex '0' zählt Zellen ohne farbigen
' Hintergrund/Standard-Schriftfarbe
' - Der zweite Parameter erwartet den Suchbereich
' - Der dritte Parameter erwartet Wahr/Falsch für die Festlegung
' ob nach Hintergrund- oder Schriftfarbe gezählt werden soll
' Bsp =ZählenWennFarbe(A1;A1:A10;0) =ZählenWennFarbe(A1;A1:A10;1)
' =ZählenWennFarbe(3;A1:A10;0) =ZählenWennFarbe(3;A1:A10;1)
'Zur automatischen Aktualisierung im Tabellenblatt den folgenden Term
'anhängen: +(0*JETZT()) und F9 drücken
'Also z.B. wie folgt: =ZählenWennFarbe(A1;A1:A10)+(0*JETZT())
Dim intColor As Integer
Dim rngCell As Range
If bolFont Then
If IsObject(varColor) Then
intColor = varColor(1).Font.ColorIndex
Else
intColor = varColor
End If
For Each rngCell In rngBereich
If rngCell.Font.ColorIndex = intColor Then
ZählenWennFarbe = ZählenWennFarbe + 1
End If
Next
Else
If IsObject(varColor) Then
intColor = varColor(1).Interior.ColorIndex
Else
intColor = varColor
End If
For Each rngCell In rngBereich
If rngCell.Interior.ColorIndex = intColor Then
ZählenWennFarbe = ZählenWennFarbe + 1
End If
Next
End If
End Function