Grüezi Annnette
Annnette Londa schrieb am 20.06.2006
Post by Annnette Londaich möchte gerne in einer Tabelle alle Zeilen mit einem farbigen
Hintergrund addieren (also z. B. alle Zellen mit rotem und alle Zellen
mit blauem Hintergrund).
Willst Du diese Zellen einfach zählen, oder die Summe deren Werte bilden?
Die folgenden Funktionen machen das eine wie das andere:
Public Function SummeWennFarbe(Bereich As Range, _
SuchFarbe As Variant, _
Optional Summe_Bereich As Range, _
Optional bolFont As Boolean = False) _
As Variant
'© ***@mvps.org, 30.05.2003
'erweitert 01.07.2004, 31.08.2004, 11.12.2004, 18.04.2005
'Funktion zur Anwendung von SUMMEWENN() mit Hintergrund- oder Schriftfarbe
'als Kriterium
'
'Die Parametereingabe erfolgt in derselben Reihenfolge
'wie in der Funktion SUMMEWENN():
' - Der erste Parameter erwartet den Suchbereich
' - Der zweite Parameter erwartet einen Zellbezug
' (Hintergrund/Schriftfarbe) oder einen Farbindex (Zahl)
' Farbindex '0' zählt Zellen ohne Hintergrund/Standard-Schriftfarbe
' - Der dritte Parameter erwartet optional den zu summierenden Bereich
' - Der vierte Parameter erwartet Wahr/Falsch für die Festlegung
' ob nach Hintergrund- oder Schriftfarbe summiert werden soll
'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: =SummeWennFarbe(A1:A10;A1)+(0*JETZT())
Dim intColor As Integer
Dim lngI As Long
Dim Summe As Variant
If Summe_Bereich Is Nothing Then Set Summe_Bereich = Bereich
If bolFont Then
If IsObject(SuchFarbe) Then
intColor = SuchFarbe(1).Font.ColorIndex
Else
intColor = SuchFarbe
End If
For lngI = 1 To Bereich.Count
If Bereich(lngI).Font.ColorIndex = intColor Then
Summe = Summe + CDec(Summe_Bereich(lngI))
End If
Next
Else
If IsObject(SuchFarbe) Then
intColor = SuchFarbe(1).Interior.ColorIndex
Else
intColor = SuchFarbe
End If
For lngI = 1 To Bereich.Count
If Bereich(lngI).Interior.ColorIndex = intColor Then
Summe = Summe + CDec(Summe_Bereich(lngI))
End If
Next lngI
End If
SummeWennFarbe = Summe
End Function
Function ZählenWennFarbe(Bereich As Range, _
SuchFarbe As Variant, _
Optional bolFont As Boolean = False) As Double
'Idee von Melanie Breden, © ***@mvps.org / 13.10.2004 / 11.12.2004
'Funktion zur Anwendung von ZÄHLENWENN mit Hintergrundfarbe
'oder Schriftfarbe als Kriterium
'
'Die Parametereingabe erfolgt in derselben Reihenfolge wie in der Funktion
'ZÄHLENWENN():
' - Der erste Parameter erwartet den Suchbereich
' - Der zwiete Parameter erwartet einen Zellbezug
(Hintergrund/Schriftfarbe)
' oder Farbindex (Zahl)
' Farbindex '0' zählt Zellen ohne farbigen
' Hintergrund/Standard-Schriftfarbe
' - Der dritte Parameter erwartet Wahr/Falsch für die Festlegung
' ob nach Hintergrund- oder Schriftfarbe gezählt werden soll
'
' Bsp =ZählenWennFarbe(A1:A10;A1;0) =ZählenWennFarbe(A1;A1:A10;1)
' =ZählenWennFarbe(A1:A10;3;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:A10;A1)+(0*JETZT())
Dim intColor As Integer
Dim rngCell As Range
If bolFont Then
If IsObject(SuchFarbe) Then
intColor = SuchFarbe(1).Font.ColorIndex
Else
intColor = SuchFarbe
End If
For Each rngCell In Bereich
If rngCell.Font.ColorIndex = intColor Then
ZählenWennFarbe = ZählenWennFarbe + 1
End If
Next
Else
If IsObject(SuchFarbe) Then
intColor = SuchFarbe(1).Interior.ColorIndex
Else
intColor = SuchFarbe
End If
For Each rngCell In Bereich
If rngCell.Interior.ColorIndex = intColor Then
ZählenWennFarbe = ZählenWennFarbe + 1
End If
Next
End If
End Function
Mit freundlichen Grüssen
Thomas Ramel (@work)
--
- MVP für Microsoft-Excel -
[Win XP Pro SP-2 / xl2003 SP-1]
Microsoft Excel - Die ExpertenTipps:
(http://tinyurl.com/9ov3l und http://tinyurl.com/cmned)