Live-Forum - Die aktuellen Beiträge
Datum
Titel
18.04.2024 21:09:11
4 Spalten aus smarter Tabelle in andere smarte Tab. kopieren
18.04.2024 20:45:35
Worksheet_Activate für alle Sheets
18.04.2024 19:30:20
VBA - Tabelle mit Mannschaftsergebnissen sortieren
18.04.2024 18:04:29
Formel fehler Wert#
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
1048to1052
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
1048to1052
1048to1052
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Farbsumme | Herbers Excel-Forum

Farbsumme
10.02.2009 08:33:08
Katja

Guten Morgen,
ich habe eine Spalte mit Uhrzeiten. Wenn die Uhrzeit zwischen 7:00 - 16:00 Uhr liegt färbt sich die Zelle gelb, außerhalb dieser Zeiten grün.
Jetzt möchte ich gern die Anzahl der Zellen zählen. Das geht auch noch mit folgender Formel:


Function CountColor(rng As Range, iColor As Integer)
Dim rngAct As Range
Dim iCount As Integer
Application.Volatile
For Each rngAct In rng.Cells
If rngAct.Interior.ColorIndex = iColor Then
iCount = iCount + 1
End If
Next rngAct
CountColor = iCount
End Function


=CountColor($A$3:$A$500;6)
Jetzt meine Frage: Ich habe unterschiedliche Abteilungen und möchte dann immer nur die Anzahl der Zellen für die jeweilige Abteilung zählen.
so in etwa: =wenn(c3="AP";CountColor($A$3:$A$500;6);"")
Aber das funktioniert nicht. Wäre super, wenn jemand eine Idee hätte.
Vielen Dank.
Gruß Katja

17
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Farbsumme
10.02.2009 08:43:16
Tino
Hallo,
z. Bsp. so.
Haben den Wert optional angegeben, lässt Du diesen weg, ist es wie zuvor.
Function CountColor(rng As Range, iColor As Integer, Optional sAbteilung = "*")
Dim rngAct As Range
Dim iCount As Integer
    Application.Volatile
    
    For Each rngAct In rng.Cells
      If rngAct.Interior.ColorIndex = iColor And rngAct.Value Like sAbteilung Then
        iCount = iCount + 1
      End If
    Next rngAct
    
    CountColor = iCount
End Function


Anzeige
AW: Farbsumme
10.02.2009 08:53:26
Katja
Hallo Tino,
vielen Dank für Deine schnelle Hilfe.
Die Funktion funktioniert noch nicht. Mache ich was falsch?
Die Abteilung steht bei mir in Spalte C und die Uhrzeiten in Spalte A.
Gruß
Katja
AW: Farbsumme
10.02.2009 08:58:18
Tino
Hallo,
ich denke Dein Code funktioniert?
Wenn ich mir Deine Frage nochmal durchlese,
verstehe ich dass Du die Färbung mit bedingter Formatierung machst.
Also müsstest Du die Bedingung in der Funktion nachbauen.
Kannst Du eine Beispieldatei hochladen?
Gruß Tino
AW: Farbsumme
10.02.2009 09:09:40
Katja
Hallo Tino,
habe Dir mal ein Beispiel hochgeladen. Hoffe, dass hilft weiter.
https://www.herber.de/bbs/user/59288.xlsm
Gruß
Katja
Anzeige
Alternative
10.02.2009 09:38:11
Ramses
Hallo Tino
hätte da noch einen Vorschlag fürs Archiv und für unbedarfte User, welche die Farbnummern nicht kennen
=CountColor($B$3:$B$246;"Grün";$D$3:$D$246;"AP")
Option Explicit

Function CountColor(rng As Range, strColor As String, Optional rngAbteilung As Range, Optional sAbteilung = "*")
    Dim iCount As Long, iColor As Integer
    
    Select Case strColor
        Case "Rot"
            iColor = 3
        Case "Grün"
            iColor = 4
        Case "Gelb"
            iColor = 6
        Case Else
            MsgBox "Diese Farbe wird nicht verwendet", vbInformation + vbOKOnly, "Fehler"
            Exit Function
    End Select
    
    Application.Volatile
    If rngAbteilung Is Nothing Then
        For Each rng In rng.Cells
            If rng.Interior.ColorIndex = iColor Then
                CountColor = CountColor + 1
            End If
        Next rng
    Else
        For Each rng In rng.Cells
            iCount = iCount + 1
            If rng.Interior.ColorIndex = iColor And rngAbteilung.Cells(iCount).Value Like sAbteilung Then
                CountColor = CountColor + 1
            End If
        Next rng
    End If
End Function
Gruss Rainer
Anzeige
auch nicht schlecht. ;-) oT.
10.02.2009 09:41:26
Tino
Gesamte Standardpalette
10.02.2009 10:10:56
RS
....und hier noch für alle Fans der Farbzählung mit der Standard-Farbpalette:
Den Select-Case aus Ramses Code ersetzen mit:


Select Case strColor
Case "Schwarz": iColor = 1
Case "Dunkelrot": iColor = 9
Case "Rot": iColor = 3
Case "Rosa": iColor = 7
Case "Hellrosa": iColor = 38
Case "Braun": iColor = 53
Case "Orange": iColor = 46
Case "Helles Orange": iColor = 45
Case "Gold": iColor = 44
Case "Gelbbraun": iColor = 40
Case "Olivgrün": iColor = 52
Case "Dunkelgelb": iColor = 12
Case "Gelbgrün": iColor = 43
Case "Gelb": iColor = 6
Case "Hellgelb": iColor = 36
Case "Dunkelgrün": iColor = 51
Case "Grün": iColor = 10
Case "Meeresgrün": iColor = 50
Case "Grelles Grün": iColor = 4
Case "Hellgrün": iColor = 35
Case "Dunkelblaugrün": iColor = 49
Case "Blaugrün": iColor = 14
Case "Aquamarin": iColor = 42
Case "Türkis": iColor = 8
Case "Helles Türkis": iColor = 34
Case "Dunkelblau": iColor = 11
Case "Blau": iColor = 5
Case "Hellblau": iColor = 41
Case "Himmelblau": iColor = 33
Case "Blassblau": iColor = 37
Case "Indigoblau": iColor = 55
Case "Blaugrau": iColor = 47
Case "Violett": iColor = 13
Case "Pflaume": iColor = 54
Case "Lavelndel": iColor = 39
Case "Grau-80%": iColor = 56
Case "Grau-50%": iColor = 16
Case "Grau-40%": iColor = 48
Case "Grau-25%": iColor = 15
Case "Weiss": iColor = 2
Case "Nix": iColor = -4142
Case Else
MsgBox "Diese Farbe wird nicht verwendet", vbInformation + vbOKOnly, "Fehler"
Exit Function
End Select


;-)) Grüsse RS

Anzeige
AW: Gesamte Standardpalette
10.02.2009 10:57:33
Tino
Hallo,
diese Auflistung finde ich nicht schlecht.
Aber wenn einer nicht weis wie man an die Farbnummer kommt, wird er bei
"Grau-80%"
"Pflaume"
...
usw.
auch seine Schwierigkeiten haben. ;-)
Gruß Tino
Bubblehelp auf der Pallette! (owT)
10.02.2009 10:59:42
RS

war ein Schertz oT.
10.02.2009 11:02:34
Tino
Lösungen wie diese beiden setzen natürlich...
10.02.2009 14:36:57
Luc:-?
...eine Standardpalette voraus, was aber nicht immer gegeben/gewünscht ist. Dabei besteht auch ein Unterschied darin, von wo aus der Farbindex aufgerufen wird...
1. Mittels einer udF in einer Zelle → es wird die Palette der jeweil ArbMappe verwendet
2. In einer Subroutine → es wird die Stddpalette verwendet, wenn nicht explizit auf die Mappe verwiesen wird.
Auch deshalb ist eine alleinige Orientierung auf den Farbindex eine Sackgasse, zumal xl12 hier ja mehr Möglichkeiten bietet. Ich hatte das Problem vor Jahren mit einer udF so gelöst, dass der Farbindex zuvor in Farbcode übersetzt wdn muss. Die udF verfügt über eine eigene Farbnamen/-code-Liste, die weitgehend auf CorelDraw-Farbnamen basiert (die xlFarbnamen sind ab und an ziemlich daneben). Diese kann per eigenem Index oder mit Code oder Name angesprochen wdn. Im Ergebnis wird dann Name oder Code zurückgegeben. Ein ermittelter Farbcode kann dann von Subroutinen zur Zell- (<xl12 eingeschränkt) bzw Objektfärbung benutzt wdn. Eine andere udF liest alle möglichen Zelleigenschaften aus, u.a. Zell- und Schriftfarben als Code, Index, HexZahl in RGB-Reihenfolge (richtig für HTML, für xl-Hex2Dec-Fktt umdrehen BGR) und Name (benutzt dazu intern die erstgenannte udF).
Leider habe ich ggw keine Zeit, mich mit diesen udF zu befassen (will sagen, diese zu optimieren), weshalb ich diese hier nicht einstellen kann (hat auch mit deren Größe und interner Verwendung weiterer udF zu tun). Sie sind halt Universal-Werkzeuge für viele Aufgaben...
Mein Beitrag soll deshalb nur als Hinweis verstanden wdn, in welcher Richtung man so etwas umsetzen sollte... ;-)
Gruß Luc :-?
Besser informiert sein!
Anzeige
oder man verwendet rgb farben. oT
10.02.2009 15:59:53
Tino
Offset für Vergleichsspalte fehlt,
10.02.2009 09:32:24
RS
Hi Katja,
Die Funktion muss eine andere Spalte auf den Vergleichswert testen, darum:


Function CountColor(rng As Range, iColor As Integer, _
Optional lColOff As Long = 1, _
Optional sAbteilung = "*") As Long
Dim rngAct As Range
Dim lCount As Long
Application.Volatile
For Each rngAct In rng.Cells
If rngAct.Interior.ColorIndex = iColor And _
rngAct.Offset(0, lColOff).Value Like sAbteilung Then
lCount = lCount + 1
End If
Next rngAct
CountColor = lCount
End Function


und der Aufruf lautet dann z.B. 


=CountColor(Zeiten!$B$3:$B$500;4;2;"AP")


wobei die 2 angibt, das 2 Spalten rechts von der Summenspalte auf "AP" verglichen wird.
Grüsse RS

Anzeige
Super, es funktioniert. Danke!
10.02.2009 09:42:54
Katja
Vielen Dank für Eure schnelle Hilfe. Es funktioniert.
Lieben Gruß
Katja
AW: Farbsumme
10.02.2009 09:43:24
fcs
Hallo Katja, Hallo Tino,
hier noch eine Variante, die ohne die Farbspielereien auskommt und nur mit den Daten arbeitet.
Außerdem kann hier auf Volatile verzichtet werden.
Gruß
Franz


Function CountColor(rngDaten As Range, Abteilung As String, _
ZeitStart As Date, ZeitEnde As Date, Optional OffsetAbteilung As Long = 1) As Long
Dim rngZeit As Range
'OffsetAbteilung ist die Position der Spalte mit der Abteilung relativ zur Spalte mit der  _
Uhrzeit
'FormelBeispiel
'=CountColor($A$7:$C$27;A1;"08:00:00";"17:00:00";2)
For Each rngZeit In rngDaten.Columns(1).Cells
If IsNumeric(rngZeit) Then
If rngZeit >= ZeitStart And rngZeit <= ZeitEnde _
And rngZeit.Offset(0, OffsetAbteilung) = Abteilung Then
CountColor = CountColor + 1
End If
End If
Next rngZeit
End Function


Anzeige
oder Summenprodukt
10.02.2009 10:42:26
Tino
Hallo Franz,

Beliebteste Forumthreads (12 Monate)

Anzeige
Jetzt das Excel-Portal bewerten: Deine Stimme zählt!

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige