Пытаюсь сделать функцию по подсчету количества ячеек по цвету шрифта и критерию, но что-то у меня не получается. В качестве основы взял в инете функцию по подсчету количества ячеек с цветом заливки и критерием (она работает нормально), поменял там параметры но не получается. Сразу скажу что я в VBA не спец, делал по интуиции. Нашел очень много подобных функций, но они суммируют значения ячеек, а мне нужно именно подсчет количества и обязательно с критерием. К примеру чтобы отображалось количество ячеек с текстом "луч" красного цвета.
[vba]
Код
'Подсчет ячеек по цвету заливки и критерию Function Count_Color(Count_Range As Range, Optional Color_ As Boolean, Optional Criteria) As Long 'Application.Volatile True Dim cell As Range, a On Error Resume Next If Len(Criteria) Then For Each cell In Count_Range If cell = Criteria Then If Color_ Then If cell.Interior.ColorIndex <> xlNone Then Count_Color = Count_Color + 1 Else If cell.Interior.ColorIndex = xlNone Then Count_Color = Count_Color + 1 End If End If Next Else For Each cell In Count_Range If Color_ Then If cell.Interior.ColorIndex <> xlNone Then Count_Color = Count_Color + 1 Else If cell.Interior.ColorIndex = xlNone Then Count_Color = Count_Color + 1 End If Next End If End Function
[/vba]
[vba]
Код
'Подсчет ячеек по цвету шрифта и критерию Function Count_Font(Count_Range As Range, Optional Font_ As Boolean, Optional Criteria) As Long 'Application.Volatile True Dim cell As Range, a On Error Resume Next If Len(Criteria) Then For Each cell In Count_Range If cell = Criteria Then If Color_ Then If cell.Font.ColorIndex <> xlNone Then Count_Font = Count_Font + 1 Else If cell.Font.ColorIndex = xlNone Then Count_Font = Count_Font + 1 End If End If Next Else For Each cell In Count_Range If Color_ Then If cell.Font.ColorIndex <> xlNone Then Count_Font = Count_Font + 1 Else If cell.Font.ColorIndex = xlNone Then Count_Font = Count_Font + 1 End If Next End If End Function
[/vba]
Помогите разобраться
Пытаюсь сделать функцию по подсчету количества ячеек по цвету шрифта и критерию, но что-то у меня не получается. В качестве основы взял в инете функцию по подсчету количества ячеек с цветом заливки и критерием (она работает нормально), поменял там параметры но не получается. Сразу скажу что я в VBA не спец, делал по интуиции. Нашел очень много подобных функций, но они суммируют значения ячеек, а мне нужно именно подсчет количества и обязательно с критерием. К примеру чтобы отображалось количество ячеек с текстом "луч" красного цвета.
[vba]
Код
'Подсчет ячеек по цвету заливки и критерию Function Count_Color(Count_Range As Range, Optional Color_ As Boolean, Optional Criteria) As Long 'Application.Volatile True Dim cell As Range, a On Error Resume Next If Len(Criteria) Then For Each cell In Count_Range If cell = Criteria Then If Color_ Then If cell.Interior.ColorIndex <> xlNone Then Count_Color = Count_Color + 1 Else If cell.Interior.ColorIndex = xlNone Then Count_Color = Count_Color + 1 End If End If Next Else For Each cell In Count_Range If Color_ Then If cell.Interior.ColorIndex <> xlNone Then Count_Color = Count_Color + 1 Else If cell.Interior.ColorIndex = xlNone Then Count_Color = Count_Color + 1 End If Next End If End Function
[/vba]
[vba]
Код
'Подсчет ячеек по цвету шрифта и критерию Function Count_Font(Count_Range As Range, Optional Font_ As Boolean, Optional Criteria) As Long 'Application.Volatile True Dim cell As Range, a On Error Resume Next If Len(Criteria) Then For Each cell In Count_Range If cell = Criteria Then If Color_ Then If cell.Font.ColorIndex <> xlNone Then Count_Font = Count_Font + 1 Else If cell.Font.ColorIndex = xlNone Then Count_Font = Count_Font + 1 End If End If Next Else For Each cell In Count_Range If Color_ Then If cell.Font.ColorIndex <> xlNone Then Count_Font = Count_Font + 1 Else If cell.Font.ColorIndex = xlNone Then Count_Font = Count_Font + 1 End If Next End If End Function
Вы за основу взяли функцию, которая, хоть и пользует критерий - но считает не по конкретному цвету заливки, а по наличию/отсутствию заливки вообще. Так что даже переделав её, забудьте про "красный"
Что же касается Пирсона... Вы всегда ищете или делаете функцию, которая выполняет конкретное назначение? Вроде бы давно уже известно, как делать многокритериальный отбор по диапазону, и даже без формул массива. Пример (на основе первого, на что наткнулся в функциях, кстати, присутствовавшее в примере):
Вы за основу взяли функцию, которая, хоть и пользует критерий - но считает не по конкретному цвету заливки, а по наличию/отсутствию заливки вообще. Так что даже переделав её, забудьте про "красный"
Что же касается Пирсона... Вы всегда ищете или делаете функцию, которая выполняет конкретное назначение? Вроде бы давно уже известно, как делать многокритериальный отбор по диапазону, и даже без формул массива. Пример (на основе первого, на что наткнулся в функциях, кстати, присутствовавшее в примере):