AW: Farbcode abfragen ?
=Peter=
Hallo Michael,
die Schriftfarbe oder die Hintergrundfarbe einer Zelle kannst du ohne VBA wie folgt ermitteln:
Einfügen -> Name -> Definieren -> Name in der Arbeitsmappe: 'Schrift' -> bezieht sich auf: =ZELLE.ZUORDNEN(24;INDIREKT("ZS(-1)";FALSCH)) -> [Hinzufügen] -> OK
Wenn du nun die folgende Formel eingibst wird die Schriftfarbe der jeweils links davon stehenden Zelle ausgegeben:
=Schrift
Wenn man anstelle der 24 die 63 verwendet erhält man die Hintergrundfarbe
In diesem Zusammenhang kannst du evtl. auch diese Benutzerdefinierte Funktion verwenden:
Function ZählenWennFarbe(varColor As Variant, rngBereich As Range, _
Optional bolFont As Boolean = False) As Double
'Idee von Melanie Breden, erweitert von Thomas Ramel / 13.10.2004
'Funktion zur Anwendung von ZÄHLENWENN mit Hintergrundfarbe
'oder Schriftfarbe als Kriterium
' - Der erste Parameter erwartet einen Zellbezug (Hintergrund/Schriftfarbe)
' oder Farbindex (Zahl)
' Farbindex '0' zählt Zellen ohne farbigen
' Hintergrund/Standard-Schriftfarbe
' - Der zweite Parameter erwartet den Suchbereich
' - Der dritte Parameter erwartet Wahr/Falsch für die Festlegung
' ob nach Hintergrund- oder Schriftfarbe gezählt werden soll
' Bsp =ZählenWennFarbe(A1;A1:A10;0) =ZählenWennFarbe(A1;A1:A10;1)
' =ZählenWennFarbe(3;A1:A10;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;A1:A10)+(0*JETZT())
Dim intColor As Integer
Dim rngCell As Range
If bolFont Then
If IsObject(varColor) Then
intColor = varColor(1).Font.ColorIndex
Else
intColor = varColor
End If
For Each rngCell In rngBereich
If rngCell.Font.ColorIndex = intColor Then
ZählenWennFarbe = ZählenWennFarbe + 1
End If
Next
Else
If IsObject(varColor) Then
intColor = varColor(1).Interior.ColorIndex
Else
intColor = varColor
End If
For Each rngCell In rngBereich
If rngCell.Interior.ColorIndex = intColor Then
ZählenWennFarbe = ZählenWennFarbe + 1
End If
Next
End If
End Function
HTH
Gruss
Peter