Function SubColor(rName As Range, rRange As Range)
Dim rAll As Range, rCell As Range, V
Dim strF As String, Cnt As Long
Dim Fa As String
Set rAll = rRange
V = rName.Value
strF = "00000000"
For Each rCell In rAll.Cells
If rCell.Value = V Then
If InStr(strF, Format(rCell.Offset(, 1).Interior.Color, "00000000")) = 0 Then
strF = strF & Format(rCell.Offset(, 1).Interior.Color, "00000000")
Cnt = Cnt + 1
End If
End If
Next rCell
SubColor = Cnt
End Function