hallo zusammen! Ich möchte zellen mit gleichem inhalt (buchstabe "N") aber mit unterschiedlichen hintergrundfarben (entweder orange oder rosa) zählen, wie mache ich das am einfachsten?
Sub test() MsgBox Range("A1").DisplayFormat.Interior.Color End Sub
was unabhängig von der Herkunft der Färbung ("normale" Füllfarbe, bedingte Formatierung) ist. Du müsstest jetzt in einer Schleife über alle entsprechenden Datenzellen gehen ...
. \\\|/// Hoffe, geholfen zu haben. ( ô ô ) Grüße, André aus G in T ooO-(_)-Ooo (Excel 97-2019+365)
18.08.2022, 21:24 (Dieser Beitrag wurde zuletzt bearbeitet: 18.08.2022, 21:34 von StefanB.)
Moin,
den Code:
Code:
Function AnzahlFarbigeZellen(Bereich As Range) Dim Zelle As Range, n As Long Application.Volatile For Each Zelle In Bereich If Zelle.Interior.ColorIndex <> xlNone Then n = n + 1 End If Next Zelle AnzahlFarbigeZellen = n End Function
in ein Modul und diese Formel:
Code:
=anzahlfarbigezellen(B1:F1)
in Zelle A1 eingeben. Nun zählt A1 alle farbigen Zellen im Bereich B1:F1. Allerdings nicht die bed. format. Zellen. In diesem Falle müssten anderen dir weiterhelfen. (Code und Formel aus CEF, Danke )
Interpunktion und Orthographie dieses Textes sind frei erfunden. Eine Übereinstimmung mit aktuellen oder ehemaligen Regeln wäre rein zufällig und ist nicht beabsichtigt.
' ' Summe bei gleichen Schriftfarben im angegebenen Bereich der Formel ' Schriftfarben, wie in der Formelzelle vorgegeben, die Formel prüft keine Zellwerte ' Nach ändern der Schriftfarbe mit F9 Summe neu Berechnen ' ' *** hddiesel *** Stand: August 2022 ' Public Function Summe_SuchBereich_FontFarbe(RngBereich As Range, FontSuchFarbe As Range) As Double Dim Zelle As Range Application.Volatile For Each Zelle In RngBereich If Zelle.Font.ColorIndex = FontSuchFarbe.Font.ColorIndex And IsNumeric(Zelle.Value) Then Summe_SuchBereich_FontFarbe = Summe_SuchBereich_FontFarbe + Zelle.Value End If Next End Function
' ' Summe bei gleichen Zellhintergrundfarben im angegebenen Bereich der Formel ' Zellhintergrundfarben, wie in der Formelzelle vorgegeben, die Formel prüft keine Zellwerte ' Nach ändern der Schriftfarbe mit F9 Summe neu Berechnen ' Public Function Summe_SuchBereich_ZellFarbe(RngBereich As Range, ZellSuchFarbe As Range) As Double Dim Zelle As Range Application.Volatile For Each Zelle In RngBereich If Zelle.Interior.ColorIndex = ZellSuchFarbe.Interior.ColorIndex And IsNumeric(Zelle.Value) Then Summe_SuchBereich_ZellFarbe = Summe_SuchBereich_ZellFarbe + Zelle.Value End If Next End Function
' ' Anzahl bei gleichen Schriftfarben im angegebenen Bereich der Formel ' Schriftfarben, wie in der Formelzelle vorgegeben, die Formel prüft keine Zellwerte ' Nach ändern der Schriftfarbe mit F9 Summe neu Berechnen ' Public Function Anzahl_SuchBereich_FontFarbe(RngBereich As Range, FontSuchFarbe As Range) As Double Dim Zelle As Range Application.Volatile For Each Zelle In RngBereich If Zelle.Font.ColorIndex = FontSuchFarbe.Font.ColorIndex Then Anzahl_SuchBereich_FontFarbe = Anzahl_SuchBereich_FontFarbe + 1 End If Next End Function
' ' Anzahl bei gleichen Zellhintergrundfarben im angegebenen Bereich der Formel ' Zellhintergrundfarben, wie in der Formelzelle vorgegeben, die Formel prüft keine Zellwerte ' Nach ändern der Schriftfarbe mit F9 Summe neu Berechnen ' Public Function Anzahl_SuchBereich_ZellFarbe(RngBereich As Range, ZellSuchFarbe As Range) As Double Dim Zelle As Range Application.Volatile For Each Zelle In RngBereich If Zelle.Interior.ColorIndex = ZellSuchFarbe.Interior.ColorIndex Then Anzahl_SuchBereich_ZellFarbe = Anzahl_SuchBereich_ZellFarbe + 1 End If Next End Function
' ' Summe bei gleichen Schriftfarben im angegebenen Bereich der Formel ' Schriftfarben, wie in der Formelzelle vorgegeben, die Formel prüft auch die angegebenen Zellwerte ' Nach ändern der Schriftfarbe mit F9 Summe neu Berechnen ' Public Function Summe_SuchBereich_FontFarbe_ZellWert(RngBereich As Range, FontSuchFarbe As Range, ZellSuchWert As Variant) As Double Dim Zelle As Range Application.Volatile For Each Zelle In RngBereich If Zelle.Font.ColorIndex = FontSuchFarbe.Font.ColorIndex And IsNumeric(Zelle.Value) And Zelle.Value = ZellSuchWert Then Summe_SuchBereich_FontFarbe_ZellWert = Summe_SuchBereich_FontFarbe_ZellWert + Zelle.Value End If Next End Function
' ' Summe bei gleichen Zellhintergrundfarben im angegebenen Bereich der Formel ' Zellhintergrundfarben, wie in der Formelzelle vorgegeben, die Formel prüft auch die angegebenen Zellwerte ' Nach ändern der Zellfarbe mit F9 Summe neu Berechnen ' Public Function Summe_SuchBereich_ZellFarbe_ZellWert(RngBereich As Range, ZellSuchFarbe As Range, ZellSuchWert As Variant) As Double Dim Zelle As Range Application.Volatile For Each Zelle In RngBereich If Zelle.Interior.ColorIndex = ZellSuchFarbe.Interior.ColorIndex And IsNumeric(Zelle.Value) And Zelle.Value = ZellSuchWert Then Summe_SuchBereich_ZellFarbe_ZellWert = Summe_SuchBereich_ZellFarbe_ZellWert + Zelle.Value End If Next End Function
' ' Anzahl der gleichen Schriftfarben im angegebenen Bereich der Formel ' Schriftfarben, wie in der Formelzelle vorgegeben, die Formel prüft auch die angegebenen Zellwerte ' Nach ändern der Schriftfarbe mit F9 Summe neu Berechnen ' Public Function Anzahl_SuchBereich_FontFarbe_ZellWert(RngBereich As Range, FontSuchFarbe As Range, ZellSuchWert As Variant) As Double Dim Zelle As Range Application.Volatile For Each Zelle In RngBereich If Zelle.Font.ColorIndex = FontSuchFarbe.Font.ColorIndex And Zelle.Value = ZellSuchWert Then Anzahl_SuchBereich_FontFarbe_ZellWert = Anzahl_SuchBereich_FontFarbe_ZellWert + 1 End If Next End Function
' ' Anzahl der gleichen Zellhintergrundfarben im angegebenen Bereich der Formel ' Zellhintergrundfarbe, wie in der Formelzelle vorgegeben, die Formel prüft auch die angegebenen Zellwerte ' Nach ändern der Zellfarbe mit F9 Summe neu Berechnen ' Public Function Anzahl_SuchBereich_ZellFarbe_ZellWert(RngBereich As Range, ZellSuchFarbe As Range, ZellSuchWert As Variant) As Double Dim Zelle As Range Application.Volatile For Each Zelle In RngBereich If Zelle.Interior.ColorIndex = ZellSuchFarbe.Interior.ColorIndex And Zelle.Value = ZellSuchWert Then Anzahl_SuchBereich_ZellFarbe_ZellWert = Anzahl_SuchBereich_ZellFarbe_ZellWert + 1 End If Next End Function