Страницы: 1
RSS
ЧАСТОТА значений диапазона игнорируя пустые ячейки
 
Доброго времени суток, уважаемые форумчане!

Есть формула, которая считает частоту заданных значений ячеек диапазона, но она работает только при отсутствии пустых ячеек в диапазоне. Подскажите, пожалуйста, как можно выполнять ту же задачу, игнорируя пустые ячейки, т.е. чтобы формула считала количество повторений значений в ячейках диапазона минуя пустые ячейки, можно и посредством VBA, но диапазонов много, повторяющиеся значения нужно считать разные.  
 
А чем СчётЕсли (он же CountIf) не угодил? Ведь нужно посчитать количество заданных значений в диапазоне? Или все-таки совокупное кол-во уникальных для диапазона?

Для подсчёта уникальных в диапазоне UDF:
Код
Function CountInRange(ByVal A#, ByVal B#, RR As Range)
Dim i&, DC As Object, arr(), mm
Set DC = CreateObject("Scripting.Dictionary")
arr = RR.Value
For Each mm In arr
  If Not DC.exists(mm) Then
    If mm >= A And mm <= B Then DC.Add mm, 0: i = i + 1
  End If
Next
CountInRange = i
Erase arr: Set DC = Nothing
End Function
--------
Изменено: Anchoret - 11.02.2019 01:43:03
 
Необходимо посчитать частоту, т.е. максимальное количество подряд повторяющихся значений, игнорируя пустые ячейки, поэтому СЧЕТЕСЛИ() не подойдет.

Например, в диапазоне такие значения: 111  2 2 12 2222221  1111 (к примеру, мне нужно посчитать максимум подряд цифры 1, тогда результат должен быть:4
Уникальные значения, это немного не то. Для моего примера уникальных значений будет 2: единицы и двойки.
 
Роман, еще UDF по подсчёту чисел в заданном интервале идущих подряд в столбце диапазона:
Код
Function CountN(ByVal A#, ByVal B#, RR As Range)
Dim i&, j&, arr(), z&, x&
arr = RR.Value
For i = 1 To UBound(arr, 2)
  For j = 1 To UBound(arr)
    x = 0
    Do While arr(j, 1) >= A And arr(j, 1) <= B
      x = x + 1: j = j + 1
      If j > UBound(arr) Then Exit Do
    Loop
    If x > z Then z = x
  Next
Next
CountN = z: Erase arr
End Function

Или по заданию в начале темы (не обращая внимания на пустые строки):
Код
Function CountN(ByVal A#, ByVal B#, RR As Range)
Dim i&, j&, arr(), z&, x&
arr = RR.Value
For i = 1 To UBound(arr, 2)
  For j = 1 To UBound(arr)
    x = 0
aaa: Do While arr(j, 1) >= A And arr(j, 1) <= B
      x = x + 1: j = j + 1
      If j > UBound(arr) Then Exit Do
    Loop
    If x > z Then z = x
    If j > UBound(arr) Then Exit For
    If Len(arr(j, i)) = 0 Then
      If j = UBound(arr) Then Exit For Else j = j + 1: GoTo aaa
    End If
  Next
Next
CountN = z: Erase arr
End Function
Изменено: Anchoret - 11.02.2019 02:04:20
 
Anchoret, спасибо, но я не очень разбираюсь в VBA... А какая пользовательская функция к этому коду?
 
Роман, открываете проект VB в книге, создаете модуль, в него нужную функцию. Если не понятно - воспользуйтесь поисковиками.

П.С.: Формат книги изменится в итоге, в обычном *xlsx макросы и пользовательские функции не живут..
 
Открыть VBA проект, создать модуль, вставить в него код, это я все понимаю. Не понимаю, какая функция будет в строке формул, чтобы в конечной ячейке выводился результат. И скажите, пожалуйста, этот код будет работать независимо от количества подряд пустых ячеек в диапазоне?
 
[USER=9597]Роман[/USER], а Вы попробуйте :) У меня работает - последняя функция из представленных. Вводится в ячейку как обычная формула: название функции, список аргументов (минимальное значение, максимальное значение, ссылка на диапазон).
Изменено: Anchoret - 11.02.2019 10:33:44
 
Anchoret, для примера с цифрами 1 и 2 код работает, спасибо! Посмотрите, пожалуйста, пример, можно ли подправить код чтобы формула работала для таких данных?
 
Роман,решетки уберите у переменных в функции.

Да, и не стоит функции скармливать целые столбцы.
Изменено: Anchoret - 11.02.2019 11:42:27
 
Anchoret, спасибо, Вам огромное! Решетки убрал, функция работает для текстовых значений! Супер!
 
Роман, вариант для целых столбцов, ну или более универсальный вариант:
Код
Function CountN(ByVal A, ByVal B, RR As Range)
Dim i&, j&, arr(), z&, x&, aa As Range
Set aa = Intersect(RR, RR.Parent.UsedRange): arr = aa.Value
For i = 1 To UBound(arr, 2)
  For j = 1 To UBound(arr)
    x = 0
aaa: Do While arr(j, 1) >= A And arr(j, 1) <= B
      x = x + 1: j = j + 1
      If j > UBound(arr) Then Exit Do
    Loop
    If x > z Then z = x
    If j > UBound(arr) Then Exit For
    If Len(arr(j, i)) = 0 Then
      If j = UBound(arr) Then Exit For Else j = j + 1: GoTo aaa
    End If
  Next
Next
CountN = z: Erase arr
End Function
Страницы: 1
Наверх