Добрый день, коллеги. Давно мучает вопрос упрощения использования операторов сравнения в UDF (и не только) Например, когда нужно использовать оператор в критерии отбора. Видел как Дмитрий (The_Prist) вышел из подобной ситуации Смотрю в сторону Application.Evaluate, но...то ли лыжи не едут При пошаговом проходе по второй функции, отслеживая Application.Evaluate("If(" & rng2.Parent.Cells(cl.Row, rng2.Column) & kr & ")"), в Watches, вообще непоняные мне значения (числовое значение критерия умноженное на 100, иногда True). Надеялся, что будут True/False Ниже код UDF с жестко прописанным оператором и попытка ее унифицировать. И файл-пример их использования Натокните на мысли. Или развейте надежды Спасибо
Скрытый текст
Код
Function СЧЁТУНИКЕСЛИ(rng1 As Range, rng2 As Range, kr As Variant) As Double
'аргументы:
'rng1 - диапазон отбора уникальных значений, обязательный
'rng2 - диапазон условий, обязательный
'kr - условие (критерий), обязательный
On Error Resume Next
With New Collection
For Each cl In rng1
If rng2.Parent.Cells(cl.Row, rng2.Column) > kr Then 'жесткий вариант
.Add cl, CStr(cl)
If Err = 0 Then
СЧЁТУНИКЕСЛИ = СЧЁТУНИКЕСЛИ + 1
Else
Err.Clear
End If
End If
Next
End With
End Function
Function СЧЁТУНИКЕСЛИ_(rng1 As Range, rng2 As Range, kr As Variant) As Double
'аргументы:
'rng1 - диапазон отбора уникальных значений, обязательный
'rng2 - диапазон условий, обязательный
'kr - условие (критерий), обязательный
On Error Resume Next
With New Collection
For Each cl In rng1
If Application.Evaluate("If(" & rng2.Parent.Cells(cl.Row, rng2.Column) & kr & ")") Then 'попытка унифицировать
.Add cl, CStr(cl)
If Err = 0 Then
СЧЁТУНИКЕСЛИ_ = СЧЁТУНИКЕСЛИ_ + 1
Else
Err.Clear
End If
End If
Next
End With
End Function
А, тогда понятно, просто файл не смотрел. Не работает, потому что Evaluate - буржуйская функция, и числа ей нужно "скармливать" тоже в буржуйском формате, т.е. например не "0,4", а "0.4". ЗЫ. "If" там все же не нужен.
Влад написал: числа ей нужно "скармливать" тоже в буржуйском формате
Спасибо. Вот так получилось
Код
Function СЧЁТУНИКЕСЛИ_(rng1 As Range, rng2 As Range, kr As String) As Double
'аргументы:
'rng1 - диапазон отбора уникальных значений, обязательный
'rng2 - диапазон условий, обязательный
'kr - условие (критерий), обязательный
On Error Resume Next
kr = Replace(kr, ",", ".")
With New Collection
For Each cl In rng1
vCl = Replace(rng2.Parent.Cells(cl.Row, rng2.Column), ",", ".")
If Application.Evaluate(vCl & kr) Then
.Add cl, CStr(cl)
If Err = 0 Then
СЧЁТУНИКЕСЛИ_ = СЧЁТУНИКЕСЛИ_ + 1
Else
Err.Clear
End If
End If
Next
End With
End Function