Summe von allen in "schwarz geschriebenen Zahlen" !

Martina H.

unread,

Aug 31, 2004, 2:17:19 AM8/31/04

to

Hallo NG,
ich möchte eine Summe (oder auch addieren) in einer
Spalte bilden in der nur die schwarz geschrieben
Zahlen oder alles auser rot und blau zusammengezählt
oder addiert wird .

Im voraus schon mal DANKE

mfg
martina

Thomas Ramel

unread,

Aug 31, 2004, 2:31:41 AM8/31/04

to

Grüezi Martina

Martina H. schrieb am 31.08.2004

> ich möchte eine Summe (oder auch addieren) in einer
> Spalte bilden in der nur die schwarz geschrieben
> Zahlen oder alles auser rot und blau zusammengezählt
> oder addiert wird .

Kennst Du dich mit VBA etwas aus?
Kopiere die folgende Funktion in ein allgemeines Modul deiner Mappe, dann
steht dir im Funktionsassistenten die neue Funktion SummeWennfarbe() zur
Verfügung:

Public Function SummeWennFarbe(Bereich As Range, SuchFarbe As Variant, _
Optional Summe_Bereich As Range, _
Optional bolFont As Boolean = False) As Double

'© Thomas Ramel, 30.05.2003 / erweitert 01.07.2004
'Funktion zur Anwendung von SUMMEWENN() mit Hintergrund- oder Schriftfarbe
'als Kriterium
'
' - 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 viertte Parameter erwartet Wahr/Falsch für die Festlegung
' ob nach Hintergrund- oder Schriftfarbe gezählt werden soll

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

Dim intI As Integer
Dim intColor As Integer
Dim Summe As Double

If bolFont Then
If IsObject(varColor) Then
intColor = varColor(1).Font.ColorIndex
Else
intColor = varColor
End If

For Each varArea In rngBereich
For Each rngCell In varArea
If rngCell <> "" And rngCell.Font.ColorIndex = intColor Then
Summe = Summe + Summe_Bereich(intI)
End If
Next
Next
Else
If IsObject(SuchFarbe) Then
intColor = SuchFarbe(1).Interior.ColorIndex
Else
intColor = SuchFarbe
End If

If Summe_Bereich Is Nothing Then Set Summe_Bereich = Bereich

For intI = 1 To Bereich.Count
If Bereich(intI).Interior.ColorIndex = intColor Then
Summe = Summe + Summe_Bereich(intI)
End If
Next intI
End If

SummeWennFarbe = Summe
End Function

--
Mit freundlichen Grüssen

Thomas Ramel
- MVP für Microsoft-Excel -

[Win XP Pro SP-1 / xl2000 SP-3]

Frank Kabel

unread,

Aug 31, 2004, 4:12:36 AM8/31/04

to

Hi
als zusätzliche Alternative:
http://www.xldynamic.com/source/xld.ColourCounter.html

>-----Originalnachricht-----

>.
>

Thomas Ramel

unread,

Aug 31, 2004, 4:59:34 AM8/31/04

to

Grüezi Thomas (ich antworte mir gleich mal selbst)

Thomas Ramel schrieb am 31.08.2004

> Kopiere die folgende Funktion in ein allgemeines Modul deiner Mappe, dann
> steht dir im Funktionsassistenten die neue Funktion SummeWennfarbe() zur
> Verfügung:

[Funktion gesnippt]

Wie ich eben noch festgestellt habe, war die Funktion ich eine Baustelle
(das kommt vom Ändern und dann unterbrechen :-( )
Die hier müsste nun für den Hintergrund wie auch die Schriftfarbe klappen
(wenn vielleicht mal wer testen möchte?):

Public Function SummeWennFarbe(Bereich As Range, SuchFarbe As Variant, _
Optional Summe_Bereich As Range, _
Optional bolFont As Boolean = False) As Double

'Funktion zur Anwendung von SUMMEWENN() mit Hintergrund- oder Schriftfarbe
'als Kriterium
'
' - 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 viertte Parameter erwartet Wahr/Falsch für die Festlegung
' ob nach Hintergrund- oder Schriftfarbe gezählt werden soll

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

Dim intColor As Integer
Dim intI As Integer
Dim Summe As Double

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 intI = 1 To Bereich.Count
If Bereich(intI).Font.ColorIndex = intColor Then

Summe = Summe + Summe_Bereich(intI)
End If
Next

Else

If IsObject(SuchFarbe) Then
intColor = SuchFarbe(1).Interior.ColorIndex
Else
intColor = SuchFarbe
End If

For intI = 1 To Bereich.Count