会社から自分に送ったメールが届いてなくて顔面蒼白です・・・。やばい。クビになったら笑いましょう(；´Д｀)

=cc(数えたい範囲,数えたい色のセル)で数える関数だよ。
↓こんな感じで使えます

Function cc(a As Range, b As Range) As Long
Set b = b.Item(1)
Dim sh As Worksheet: Set sh = a.Parent
If Intersect(a, sh.UsedRange) Is Nothing Then
cc = 0
Exit Function
End If
Dim countcolor As Long: countcolor = b.Interior.Color
Dim lc As Long: lc = WorksheetFunction.Min(a.Item(a.count).Column, sh.UsedRange.Item(sh.UsedRange.count).Column)
Dim lr As Long: lr = WorksheetFunction.Min(a.Item(a.count).Row, sh.UsedRange.Item(sh.UsedRange.count).Row)
Dim c As Long, r As Long, count As Long: count = 0
For c = a.Item(1).Column To lc
For r = a.Item(1).Row To lr
If sh.Cells(r, c).Interior.Color = countcolor Then count = count + 1
Next
Next
cc = count
End Function

A:Aみたいに列で色つけた場合は全部は数えません。使用範囲（UsedRange）内で数えます。

なので、例えば別のシートからだとこんな感じになります。