farbige Buchstaben zählen

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

Sub fonttest()
Dim r As Range, i As Integer
Set r = Cells(1, 1)
For i = 1 To r.Characters.Count
Debug.Print r.Characters(i, 1).Text
Debug.Print r.Characters(i, 1).Font.ColorIndex
Next
End Sub