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, 20:24 (Dieser Beitrag wurde zuletzt bearbeitet: 18.08.2022, 20: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