Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
Подсчёт количества уникальных значений среди отфильтрованных
 
#1
08.05.2017 13:06:43
Приветствую.

Цель: подсчитать количество уникальных значений в ячейках, отобранных с помощью фильтра (или нескольких).
Пример во вложении, поиск уникальных значений осуществляется в столбце "В". Для подсчёта используется следующая формула:
=СУММПРОИЗВ((ЧАСТОТА(ПОИСКПОЗ(B2:B10&"";B2:B10&"";0);ПОИСКПОЗ(B2:B10&"";B2:B10&"";0))>0)*ПРОМЕЖУТОЧНЫЕ.ИТОГИ(3;СМЕЩ(A2;СТРОКА(A2:A11)-СТРОКА(A2);)))
Работает хорошо, за исключением одной детали: при отдельных условиях фильтрации в столбце "D" выдаёт ложный результат. Во вложенном файле попробуйте в этом столбце отфильтровать ячейки по критерию "сдан" - результат будет 2 (вместо 3).
Насколько понял, эта ошибка связана с тем, что формула работает следующим образом:
- ячейки просматриваются сверху вниз
- в качестве уникального учитывается первое найденное среди повторяющихся значений
- если ячейка, содержащая такое значение, скрывается в результате фильтрации, формула выдаёт 0 - в том числе, и в случаях, когда остаются видимыми остальные повторяющиеся значения
На примере из вложения:
- значение "5А" встречается в ячейках "В3", "В7", "В10"
- в качестве уникального учитывается значение в ячейке "В3"
- если в столбце "D" фильтровать по критерию "не сдан", формула выдаст верный результат, т. к. ячейка "В3" осталась видимой
- если в столбце "D" фильтровать по критерию "сдан", формула выдаст неверный результат, т. к. ячейка "В3" перестала быть видимой

Можно ли как-то исправить недостаток имеющейся формулы? Если да, что именно следует изменить. Если нет, подскажите, пожалуйста, какую формулу можно использовать для решения вопроса..
Изменено: Boggy - 08.05.2017 13:21:57
 
 
 
#2
08.05.2017 13:22:12
Не уверен, что можно настроить зависимость формулы от фильтра. Я бы использовал UDF (пользовательская функция)
Код
Function СЧЁТУНИКЕСЛИ(rng1 As Range, rng2 As Range, kr As Variant) As Double
'аргументы:
'rng1 - диапазон отбора уникальных значений, обязательный
'rng2 - диапазон условий, обязательный
'kr - условие (критерий), обязательный
СЧЁТУНИКЕСЛИ = 0
On Error Resume Next
    With New Collection
        For Each cl In rng1
            If rng2.Parent.Cells(cl.Row, rng2.Column) Like kr Then
                .Add cl, CStr(cl)
                If Err = 0 Then
                    СЧЁТУНИКЕСЛИ = СЧЁТУНИКЕСЛИ + 1
                Else
                    Err.Clear
                End If
            End If
        Next
    End With
End Function
Согласие есть продукт при полном непротивлении сторон
 
 
 
#3
08.05.2017 16:49:44
Sanja, огромное спасибо за совет и код. Но, возможно, я недостаточно явно выразил цель в первом посте: необходим подсчёт уникальных значений в видимом с учётом фильтрации диапазоне, с фильтрацией по любому количеству критериев. Но предложенный Вами код считает по всему диапазону, без учёта фильтрации, по заранее заданному критерию.
Нашёл вариант, который, судя по описанию, выглядит подходящим. У функции два аргумента - "ДИАПАЗОН" и "ТолькоВидимые". Первый задаёт диапазон отбора уникальных значений, второй принимает значения "0" или "1" и, соответственно, учитывает или не учитывает скрытые ячейки диапазона.
Выглядит это так:

Но работает не совсем так, как сказано в описании - у функции нет  аргумента "ТолькоВидимые". Или я что-то делаю не так, или автор из  коммерческих соображений опубликовал только часть кода. Посмотрите, пожалуйста, и подтвердите/опровергните мою догадку.
P.S.: указание на работоспособность кода видел в этом сообщении,
Изменено: Boggy - 08.05.2017 17:12:10
 
 
 
#4
08.05.2017 17:13:14
Отфильтрованный диапазон - это просто скрытые строки (Height = 0). В приведённом Вами макросе производится проверка на пустоту, а проверка на отфильтрованность - нет. Вам надо использовать SpecialCells вместе с Areas (так как могут быть несвязанные диапазоны).
There is no knowledge that is not power
 
 
 
#5
08.05.2017 17:47:25
Ну попробуйте так
Код
Function СЧЁТУНИКЕСЛИ(rng1 As Range, rng2 As Range, kr As Variant, Optional vis As Boolean = False) As Double
'аргументы:
'rng1 - диапазон отбора уникальных значений, обязательный
'rng2 - диапазон условий, обязательный
'kr - условие (критерий), обязательный
'vis - отбирать только в видимых ячейках, не обязательный, 0(False) - во всех (по умолчанию), 1(True) - только в видимых
СЧЁТУНИКЕСЛИ = 0
If vis Then Set rng1 = rng1.SpecialCells(xlCellTypeVisible)
On Error Resume Next
    With New Collection
        For Each cl In rng1.Cells
            If rng2.Parent.Cells(cl.Row, rng2.Column) Like kr Then
                .Add cl, CStr(cl)
                If Err = 0 Then
                    СЧЁТУНИКЕСЛИ = СЧЁТУНИКЕСЛИ + 1
                Else
                    Err.Clear
                End If
            End If
        Next
    End With
End Function
Согласие есть продукт при полном непротивлении сторон
 
 
 
#6
08.05.2017 19:09:11
Попробовал - количество уникальных остаётся неизменным при любых условиях фильтрации.
 
 
 
#7
08.05.2017 20:03:07
Приложите более информативный файл, с большим количеством данных. Или я чего-то не понимаю.
Вам нужно количество уникальных НЕ зависимо от условия?
Потому что
Цитата
Boggy написал: попробуйте в этом столбце отфильтровать ячейки по критерию "сдан" - результат будет 2 (вместо 3)
результат работы моей функции, что до, что после фильтрации равен 3, т.е. она не зависит от фильтра
Согласие есть продукт при полном непротивлении сторон
 
 
 
#8
08.05.2017 21:29:54
Может так Вам нужно
Код
Function СЧЁТУНИКВИД(rng1 As Range, Optional vsb As Boolean = False) As Double
'аргументы:
'rng1 - диапазон отбора уникальных значений, обязательный
'vsb - отбирать только в видимых ячейках, не обязательный, 0(False) - во всех (по умолчанию), 1(True) - только в видимых
Dim cl As Range
СЧЁТУНИКВИД = 0
On Error Resume Next
    With New Collection
        For Each cl In rng1
            If vsb Then
                If cl.Rows.Hidden Then GoTo 1
            End If
            .Add cl, CStr(cl)
            If Err = 0 Then
                СЧЁТУНИКВИД = СЧЁТУНИКВИД + 1
            Else
                Err.Clear
            End If
1       Next
    End With
End Function
Согласие есть продукт при полном непротивлении сторон
 
 
 
#9
08.05.2017 21:40:11
Цитата
Sanja написал:
результат работы моей функции, что до, что после фильтрации равен 3, т.е. она не зависит от фильтра
Но ведь автор сразу просил "среди отфильтрованных" ))
 
 
 
#10
08.05.2017 21:52:35
Я подумал, что 'ехать' важнее чем 'шашечки'. Результат-же в итоге нужный получается
Согласие есть продукт при полном непротивлении сторон
 
 
 
#11
10.05.2017 19:26:06
Sanja, нужным результатом был подсчёт количества значений с диапазоне, образованном фильтром/фильтрами. Да и Вы вроде всё правильно поняли, если судить по формуле - иначе зачем было вводить параметр
Цитата
'vis - отбирать только в видимых ячейках, не обязательный, 0(False) - во всех (по умолчанию), 1(True) - только в видимых
Так или иначе, нашёл подходящее решение, делюсь им. Вот ссылка на автора, от себя добавил одну строку (на игнорирование пустых ячеек). Код:
Код
Function CountUnicalVisible (ByVal RangeArea As Range) As Long
    Dim objDict As Variant
    Set objDict = CreateObject("Scripting.Dictionary")
    For Each TheCell In RangeArea
        If Not TheCell.Parent.Rows(TheCell.Row).Hidden And _
           Not TheCell.Parent.Columns(TheCell.Column).Hidden And _
           Not IsEmpty(TheCell) And _
           Not objDict.exists(TheCell.Value) Then _
             objDict.Add TheCell.Value, ""
    Next
    CountUnicalVisible = objDict.Count
    objDict = Empty
End Function
 
 
 
Страницы: 1
Читают тему
Наверх