Добрый день. Возникала проблема подсчета уникальных значений. Как одной формулой подсчитать количество уникальных имен для каждого подразделения? Функция ВПР выдает имена в текстовой форме, а нужно чтобы рядом с каждым подразделением было написано количество уникальных.
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
Согласие есть продукт при полном непротивлении сторон
Хотелось бы избежать макросов. Нужно сделать как можно проще, в одно действие. Функция счетесли не дает такого результата. Так как диапазон - это столбец А, а критерий, например Подразделение 1.
в дополнение к UDF из #2 с использованием коллекции,вариант со словарем,кнопки test и очистка и UDF
Код
Function uuu&(r As Range, t$)
Dim i&, z: z = r.Value
With CreateObject("scripting.dictionary"): .CompareMode = 1
.RemoveAll
For i = 1 To UBound(z)
If z(i, 1) = t And .exists(z(i, 2)) = False Then .Item(z(i, 2)) = .Item(z(i, 2)) + 1
Next
uuu = .Count
End With
End Function
Код
Sub test()
Dim i&, j&, z: z = Range("A2:B" & Range("A" & Rows.Count).End(xlUp).Row).Value
With CreateObject("scripting.dictionary"): .CompareMode = 1
For j = 2 To Range("D" & Rows.Count).End(xlUp).Row
For i = 1 To UBound(z)
If z(i, 1) = Range("D" & j).Value And .exists(z(i, 2)) = False Then .Item(z(i, 2)) = .Item(z(i, 2)) + 1
Next
Range("E" & j) = .Count: .RemoveAll
Next
End With
End Sub