Наряду с суммированием ячеек по цвету заливки задача подсчитать ячейки по цвету шрифта пользуется не меньшей популярностью. Поэтому выкладываю текст пользовательской функции, которая суммирует данные ячеек на основе цвета шрифта. Так же как и моя функция SumByInteriorColor - функция SumByFontColor может работать только с видимыми ячейками. Т.е. если отфильтровать диапазон, то функция подсчитает данные только отфильтрованных ячеек.
Если не знаете что такое функция пользователя советую сначала прочитать статью: Что такое функция пользователя(UDF)?

Option Explicit
 
'---------------------------------------------------------------------------------------
' Procedure : SumByFontColor
' Author    : The_Prist(Щербаков Дмитрий)
'             http://www.excel-vba.ru
' Purpose   : Функция суммирования ячеек на основе цвета заливки.
' Аргументы:
'             rRange     - диапазон с ячейками для суммирования.
'             rColorCell - ячейка-образец с цветом шрифта.
'             bSumHide   - ИСТИНА или 1 учитывает скрытые ячейки.
'                          ЛОЖЬ, 0 или опущен(по умолчанию) - скрытые ячейки не суммируются.
'---------------------------------------------------------------------------------------
Function SumByFontColor(rRange As Range, rColorCell As Range, Optional bSumHide As Boolean = False)
    'Application.Volatile  'раскомментировать, чтобы функция обновляла свои значения по нажатию Shift+F9(пересчет листа)
    Dim lColor As Long, rCell As Range, dblSum As Double, vVal
    lColor = rColorCell.Font.Color
    For Each rCell In rRange
        If rCell.Font.Color = lColor Then
            vVal = rCell.Value
            If IsNumeric(vVal) Then
                If rCell.EntireRow.Hidden Or rCell.EntireColumn.Hidden Then
                    If bSumHide Then dblSum = dblSum + rCell.Value
                Else
                    dblSum = dblSum + rCell.Value
                End If
            End If
        End If
    Next rCell
    SumByFontColor = dblSum
End Function

Синтаксис функции:
без учета скрытых строк и столбцов:
=SumByFontColor($A$1:$A$10;B1)
все ячейки:
=SumByFontColor($A$1:$A$10;B1;1)

rRange($A$1:$A$10) - ссылка на диапазон с ячейками для суммирования.
rColorCell(B1) - ссылка на ячейка-образец с цветом шрифта.
bSumHide - Если указано ИСТИНА или 1 учитывает скрытые ячейки. ЛОЖЬ, 0 или опущен(по умолчанию) - скрытые ячейки не суммируются.


 

Чтобы подсчитывалось количество ячеек, а не их сумма, то функцию надо изменить самую малость:

'---------------------------------------------------------------------------------------
' Procedure : CountByFontColor
' Author    : The_Prist(Щербаков Дмитрий)
'             http://www.excel-vba.ru
' Purpose   : Функция подсчета ячеек на основе цвета шрифта.
' Аргументы:
'             rRange     - диапазон с ячейками для подсчета.
'             rColorCell - ячейка-образец с цветом шрифта.
'             bSumHide   - ИСТИНА или 1 учитывает скрытые ячейки.
'                          ЛОЖЬ, 0 или опущен(по умолчанию) - скрытые ячейки не подсчитываются.
'---------------------------------------------------------------------------------------
Function CountByFontColor(rRange As Range, rColorCell As Range, Optional bSumHide As Boolean = False)
    'Application.Volatile  'раскомментировать, чтобы функция обновляла свои значения по нажатию Shift+F9(пересчет листа)
    Dim lColor As Long, rCell As Range, lCnt As Long, vVal
    lColor = rColorCell.Font.Color
    For Each rCell In rRange
        If rCell.Font.Color = lColor Then
            If rCell.EntireRow.Hidden Or rCell.EntireColumn.Hidden Then
                If bSumHide Then lCnt = lCnt + 1
            Else
                lCnt = lCnt + 1
            End If
        End If
    Next rCell
    CountByFontColor = lCnt
End Function

Синтаксис и аргументы полностью идентичны с функцией SumByFontColor.

Что следует учитывать: функции подсчитывают и суммируют ячейки на основании цвета шрифта, установленного вручную с панели. Если цвет шрифта создан при помощи условного форматирования, то функции не определят цвет шрифта этой ячейки. Это связано с особенностями создания визуального изменения свойств ячейки при помощи условного форматирования.

Так же функции не будут автоматически обновлять значения сразу после смены заливки ячеек - это особенность Excel. Поэтому при изменении заливки в вычисляемом диапазоне необходимо вручную пересчитать функцию(F2 -Enter).

Добавить комментарий

Этот сайт использует Akismet для борьбы со спамом. Узнайте, как обрабатываются ваши данные комментариев.