Подсчитать сумму ячеек по цвету заливки

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

Option Explicit
 
'---------------------------------------------------------------------------------------
' Procedure : SumByInteriorColor
' Author    : The_Prist(Щербаков Дмитрий)
'             http://www.excel-vba.ru
' Purpose   : Функция суммирования ячеек на основе цвета заливки.
' Аргументы:
'             rRange     - диапазон с ячейками для суммирования.
'             rColorCell - ячейка-образец с цветом заливки.
'             bSumHide   - ИСТИНА или 1 учитывает скрытые ячейки.
'                          ЛОЖЬ, 0 или опущен(по умолчанию) - скрытые ячейки не суммируются.
'---------------------------------------------------------------------------------------
Function SumByInteriorColor(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.Interior.Color
    For Each rCell In rRange
        If rCell.Interior.Color = lColor Then
            vVal = rCell.Value
            If IsNumeric(vVal) Then
                If rCell.EntireRow.Hidden Or rCell.EntireColumn.Hidden Then
                    If bSumHide Then dblSum = dblSum + vVal
                Else
                    dblSum = dblSum + vVal
                End If
            End If
        End If
    Next rCell
    SumByInteriorColor = dblSum
End Function

Чтобы правильно использовать приведенный код, необходимо сначала ознакомиться со статьей Что такое функция пользователя(UDF)?. Вкратце: скопировать текст кода выше, перейти в редактор VBA(Alt+F11) -создать стандартный модуль(Insert -Module) и в него вставить скопированный текст. После чего функцию можно будет вызвать из Диспетчера функций(Shift+F3), отыскав её в категории Определенные пользователем (User Defined Functions).

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

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

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

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

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

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

    Видеоуроки

Поиск по меткам