Найдите наиболее повторяющееся значение, но только в ячейках определенного цвета в excel

Привет,

Я знаю вот эту формулу

=MODE(!B:B)

дает вам наиболее повторяющиеся значения в столбце B, но я хочу подсчитывать только цветные ячейки. Это вообще возможно?

Спасибо.

Обновлено:

вот так выглядит мой модуль:

Function GetInfo(TopObj As Variant, PropertySpec As Variant) As Variant

Dim PropArr As Variant ' array returned by Split of object tree
Dim ItemSpec As Variant ' item in collection
Dim Obj As Object ' generic Object to hold
                  'the top-level object (ws,wb,range, or app)
Dim Ndx As Long ' loop counter
Dim Pos1 As Integer ' used to find the Item specified in collection objects
Dim Pos2 As Integer ' used to find the Item specified in collection objects
Dim TempObj As Object

'
' split the object/property spec
'
PropArr = Split(PropertySpec, ".")
'
' If Rng is an object, then it must be a Range. That's the only
' type of object you pass from a cell.
'
If IsObject(TopObj) Then
    Set Obj = TopObj
Else
    '
    ' Otherwise, it better be one of the following strings. Else,
    ' blow up the user.
    '
    Select Case UCase(TopObj)
        Case "APP", "APPLICATION"
            Set Obj = Application
        Case "WB", "TWB", "THISWORKBOOK", "WORKBOOK"
            Set Obj = ThisWorkbook
        Case "WS", "TWS", "THISWORKSHEET", "WORKSHEET"
            Set Obj = Application.Caller.Parent
        Case Else
            GetInfo = CVErr(xlErrValue)
    End Select
End If

For Ndx = LBound(PropArr) To UBound(PropArr) - 1
    '
    ' this block of code is for handling items of a collection
    '
    Pos1 = InStr(1, PropArr(Ndx), "(")
    If Pos1 > 0 Then
        '
        ' if we've found the open paren, we're dealing with an
        ' item of a collection. now, find the closing paren.
        '
        Pos2 = InStr(1, PropArr(Ndx), ")")
        ItemSpec = Mid(PropArr(Ndx), Pos1 + 1, Pos2 - Pos1 - 1)
        If IsNumeric(ItemSpec) Then
            ' numeric -- going by index number
            ItemSpec = CLng(ItemSpec)
        Else
            ' string -- going by key name, so get rid of any quotes.
            ItemSpec = Replace(ItemSpec, """", "")
        End If
        '
        ' call the Item method of the collection object.
        '
        Set Obj = CallByName(Obj, Mid(PropArr(Ndx), 1, Pos1 - 1), _
            VbGet, ItemSpec)
    Else
        '
        ' we're not dealing with collections. just get the object.
        '
        Set Obj = CallByName(Obj, PropArr(Ndx), VbGet)
    End If
Next Ndx
'
' get the final property (typically 'name' or 'value' of the object tree)
'
If IsObject(Obj) Then
    GetInfo = CallByName(Obj, PropArr(UBound(PropArr)), VbGet)
End If

End Function

Public Function getArrayInfo(rng As Range, atr As String) As Variant
Dim temp As Excel.Range
Dim out() As Variant
Dim i As Long
i = 1

ReDim out(1 To rng.Rows.Count, 1 To 1)
Set temp = Intersect(rng, ActiveSheet.UsedRange)

For Each Item In temp.Cells
    out(i, 1) = GetInfo(Item, atr)
    i = i + 1
Next Item

getArrayInfo = out

End Function