Option Explicit
 
Private Const ctxt = "c" 'Collection-Keys müssen mit einem Buchstaben oder 
' Unterstrich anfangen
Private Const splitchar = "="
 
Sub CheckColorIndex()
  On Error Resume Next
 
  Dim R As Range, C As Collection
  Dim sRange As String, sKey As String
  Dim x As Long, v As Variant
 
  sRange = "A1:C3"
 
  Set C = New Collection
  For Each R In ThisWorkbook.Worksheets(1).Range(sRange)
    Err.Clear
    sKey = ctxt & CStr(R.Interior.ColorIndex) '.ColorIndex liefert die Farb-ID 
    ' von Excel / .Color würde den Farbwert zurückgeben
 
    v = Array() ' Array-Variable zurücksetzen
    v = Split(C(sKey), splitchar)
    If (Err.Number <> 0) Then
      C.Add CStr(R.Interior.ColorIndex) & splitchar & "1", sKey
    Else
      C.Remove sKey
      C.Add v(0) & splitchar & CStr(CLng(v(1)) + 1), sKey
    End If
 
  Next R
  Set R = Nothing
 
  'ColorIndex=xlColorIndexNone  --> Keine Farbe
 
  MsgBox "In """ & sRange & """ werden " & C.Count & " Farbe(n) verwendet."
 
  For x = 1 To C.Count
    MsgBox x & ".Farbe: ColorIndex " & C(x) & "x verwendet"
  Next x
 
  Set C = Nothing
End Sub

Viel Spass,
R@lf