Sub countColor()
'シート内の色付きセルの数をカウントし、
'新規シートに色番号と個数の一覧を作成する。
'2005/08/06 pPoy
    Dim x As Range, r As Range
    Dim sName As String             '現在のシート名
    Dim ans(60) As Double           '色番号格納配列
    Dim i As Integer, j As Integer
    
    j = False
    sName = ActiveSheet.Name
    
    '色番号別に個数を配列に格納
    For Each x In Worksheets(sName).UsedRange.Areas
        For Each r In x.Cells
            i = r.Interior.ColorIndex
            If i > 0 And i <= 60 Then
                ans(i) = ans(i) + 1
                j = True
            End If
        Next r
    Next x
    
    '新規シート追加
    If j = True Then
        Worksheets.Add
        'シートに転記
        With ActiveSheet
            '見出し設定
            .Range("a1").Value = "処理日：　" & _
                                Format(Now, "yyyy/mm/dd (aaa) hh:mm")
            .Range("a2").Value = "対象シート名：　" & sName
            .Range("a3").Value = "色番号"
            .Range("b3").Value = "色付きセル数"
            '検索結果は4行目から転記
            j = 4
            For i = 1 To 60
                If ans(i) <> 0 Then
                    With .Cells(j, 1)
                        .Value = i
                        .Interior.ColorIndex = i
                        .Font.FontStyle = "太字"
                    End With
                    .Cells(j, 2).Value = ans(i)
                    j = j + 1
                End If
            Next i
        End With
        MsgBox "処理終了〜！", vbOKOnly
    Else
        MsgBox "現在のシートに色付きのセルはありませんでした〜"
    End If
End Sub

• 色番号 (カラーパレットの番号) は使用する PC で変更することができます。
  そのため、このマクロを実行する環境によっては結果が異なる場合があります。
  
  
• 標準のカラーパレットの色番号一覧は、こちらです。 (頁の下の方にあります。)