Function CountCellsByColor(rData As Range, cellRefColor As Range) As Long
Dim indRefColor As Long
Dim cellCurrent As Range
Dim cntRes As Long, DoneCells As Range, zz As Range
Application.Volatile
cntRes = 0
indRefColor = cellRefColor.Cells(1, 1).Interior.Color
For Each cellCurrent In rData
Set zz = Nothing
On Error Resume Next
Set zz = Intersect(cellCurrent, DoneCells)
On Error GoTo 0
If zz Is Nothing Then
If indRefColor = cellCurrent.Interior.Color Then
cntRes = cntRes + 1
End If
End If
If DoneCells Is Nothing Then Set DoneCells = cellCurrent.MergeArea Else Set DoneCells = Union(DoneCells, cellCurrent.MergeArea)
Next cellCurrent
CountCellsByColor = cntRes
End Function