Задача подсчитать ячейки по цвету заливки перестала быть даже редкостью - данный вопрос постоянно появляется на форумах. Решил выложить текст пользовательской функции, которая суммирует данные ячеек на основе цвета заливки. В чем отличие от остальных функций в интернете - функция может работать только с видимыми ячейками. Т.е. если отфильтровать диапазон, то функция подсчитает данные только отфильтрованных ячеек.
Если не знаете что такое функция пользователя советую сначала прочитать статью: Что такое функция пользователя(UDF)?
OptionExplicit'---------------------------------------------------------------------------------------' 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 AsBoolean = False)
'Application.Volatile 'раскомментировать, чтобы функция обновляла свои значения по нажатию Shift+F9(пересчет листа)Dim lColor AsLong, rCell As Range, dblSum AsDouble, vVal
lColor = rColorCell.Interior.Color
ForEach rCell In rRange
If rCell.Interior.Color = lColor Then
vVal = rCell.Value
If IsNumeric(vVal) ThenIf rCell.EntireRow.Hidden Or rCell.EntireColumn.Hidden ThenIf bSumHide Then dblSum = dblSum + vVal
Else
dblSum = dblSum + vVal
EndIfEndIfEndIfNext rCell
SumByInteriorColor = dblSum
EndFunction
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 AsBoolean = False, _
Optional IsMissEmpty AsBoolean = True)
'Application.Volatile 'раскомментировать, чтобы функция обновляла свои значения по нажатию Shift+F9(пересчет листа)Dim lColor AsLong, rCell As Range, lCnt AsLong, vVal
lColor = rColorCell.Interior.Color
ForEach rCell In rRange
If rCell.Interior.Color = lColor Then
vVal = 1
If rCell.EntireRow.Hidden Or rCell.EntireColumn.Hidden ThenIfNot bSumHide Then
vVal = 0
EndIfEndIfIf IsMissEmpty ThenIf Len(rCell.Value) = 0 Then
vVal = 0
EndIfEndIf
lCnt = lCnt + vVal
EndIfNext rCell
CountByInteriorColor = lCnt
EndFunction
'---------------------------------------------------------------------------------------
' 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).
10 комментариев
Добрый вечер. Подскажите, возможно ли в Ваш макрос добавить вторую ячейку - образец для цвета? Причем таким образом, если не указана вторая ячейка-образец, то сумма ведется по первой, а если указана вторая, то по двум образцам?
Добрый день. А как добавить второе условие? например =SumByInteriorColor($A$1:$A$10;B1;$A$1:$A$10;<50)или как в СУММЕСЛИМН(диапазон_суммирования, диапазон_условий1, условие1,[диапазон_условий2, условие2], …) добавить условие по цвету ячейки
Добрый день! Подскажите пожалуйста. Как прописать код так, чтобы объединенные ячейки одного цвета он считал как одну, а не как количество объединенных?
Огромное Вам спасибо! Что только я ни читала и что не делала - результата "ноль"! И только Ваши рекомендации помогли. Это реально то, что мне нужно было. Все проверила, работает. Только я поменяла модификацию в формуле, так как мне нужно было скопировать на несколько строк с одним условием. СПАСИБО!
Добрый вечер. Подскажите, возможно ли в Ваш макрос добавить вторую ячейку - образец для цвета? Причем таким образом, если не указана вторая ячейка-образец, то сумма ведется по первой, а если указана вторая, то по двум образцам?
Можно. Для этого и выложил код - посмотрели принцип и при желании доработали под свои нужды.
Отлично! Две формулы - и все по делу. Большое спасибо!
Добрый день. А как добавить второе условие? например =SumByInteriorColor($A$1:$A$10;B1;$A$1:$A$10;<50)или как в СУММЕСЛИМН(диапазон_суммирования, диапазон_условий1, условие1,[диапазон_условий2, условие2], …) добавить условие по цвету ячейки
Добавить можно только изменив код, внедрив туда еще один критерий и диапазон и, соответственно, сравнение по ним.
Добрый день! Подскажите пожалуйста. Как прописать код так, чтобы объединенные ячейки одного цвета он считал как одну, а не как количество объединенных?
Огромное Вам спасибо! Что только я ни читала и что не делала - результата "ноль"! И только Ваши рекомендации помогли. Это реально то, что мне нужно было. Все проверила, работает. Только я поменяла модификацию в формуле, так как мне нужно было скопировать на несколько строк с одним условием. СПАСИБО!
Ирина, спасибо за отзыв! Рад, что статья помогла Вам.
Нету функции для подсчета количества ячеек залитых при помощи условного форматирования?
Здесь я выкладывал готовую надстройку:Надстройка для суммирования ячеек по цвету заливки или шрифта