Gruß Redneck
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
Die erweiterte Suchfunktion hilft dir, gezielt die besten Antworten zu finden
Suche nach den besten AntwortenEntdecke unsere meistgeklickten Beiträge in der Google Suche
Top 100 Threads jetzt ansehen