Подсчитать сумму ячеек по цвету шрифта
Наряду с суммированием ячеек по цвету заливки задача подсчитать ячейки по цвету шрифта пользуется не меньшей популярностью. Поэтому выкладываю текст пользовательской функции, которая суммирует данные ячеек на основе цвета шрифта. Так же как и моя функция 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 |
Синтаксис функции:
без учета скрытых строк и столбцов:
все ячейки:
rRange(
rColorCell(
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).
Статья помогла? Поделись ссылкой с друзьями!
Видеоуроки
