Функция (UDF) "СЧЁТ_РАЗНЫХ"

Старая форма входа

Страница 1 из 1 1
Модератор форума: _Boroda_, китин

Функция (UDF) "СЧЁТ_РАЗНЫХ" (Возвращает число уникальных значений в диапазоне)

Функция (UDF) "СЧЁТ_РАЗНЫХ"

Alex_ST

Дата: Четверг, 26.08.2010, 10:30 | Сообщение № 1

Группа: Друзья

Ранг: Участник клуба

Сообщений: 3213

Репутация: 609 ±

Замечаний: 0% ±

2003

=======================================================
Функция (UDF) "СЧЁТ_РАЗНЫХ"
=======================================================
Данная Определенная пользователем функция (User-Defined Function или UDF) возвращает в ячейку листа, куда она введена, число уникальных значений в указанном диапазоне:
[vba]

Код

Function СЧЁТ_РАЗНЫХ(Диапазон As Range) As Long
      '---------------------------------------------------------------------------------------
      ' Procedure       : СЧЁТ_РАЗНЫХ
      ' Author            : Alex_ST
      ' Topic_HEADER : Подсчет количества уникальных значений в массиве
      ' Topic_URL       : http://www.planetaexcel.ru/forum.php?thread_id=16844
      ' Post_Author     :
      ' Post_URL         : http://www.planetaexcel.ru/docs/forum_upload/post_131800.zip
      '---------------------------------------------------------------------------------------
      Dim TmpArr(), iArr
      TmpArr = Intersect(Диапазон.Parent.UsedRange, Диапазон).Value
      On Error Resume Next
      With New Collection
         For Each iArr In TmpArr
            If iArr <> "" Then .Add iArr, Trim(iArr)
         Next
         СЧЁТ_РАЗНЫХ = .Count
      End With
End Function

[/vba]
Примечания:
1. Производить предварительную "зачистку" диапазона от лидирующих и финиширующих пробелов нет необходимости, т.к. они в UDF и так игнорируются.
2. Если необходимо очищать не только от лидирующих и финиширующих пробелов, но также и от множественных пробелов внутри стринга, то вместо строки
[vba]

Код

If iArr <> "" Then .Add iArr, Trim(iArr)

[/vba]
можно написать:
[vba]

Код

If iArr <> "" Then .Add iArr, Application.Trim(iArr)

[/vba]
или (если не будет работать):
[vba]

Код

If iArr <> "" Then .Add iArr, Application.WorksheetFunction.Trim(iArr)

[/vba]
НО в таком случае возможны "тормоза"
3. Для ускорения работы указанный в аргументе функции Диапазон ограничивается до UsedRange. Поэтому можно указывать целиком столбец, не опасаясь больших "тормозов".
4. Возможно было бы и более очевидное решение - перебор в цикле не элементов массива, а значений ячеек:
[vba]

Код

With New Collection
         For Each iCell In Диапазон
            If iCell.Value <> "" Then .Add iCell.Value, Trim(iCell.Value)
         Next
         СЧЁТ_РАЗНЫХ_0 = .Count
      End With

[/vba]
Но применение предварительного копирования из диапазона в массив ускоряет работу почти в 5 раз!

Код

If iArr <> "" Then .Add iArr, Trim(iArr)

[/vba]
можно написать:
[vba]

Код

If iArr <> "" Then .Add iArr, Application.Trim(iArr)

[/vba]
или (если не будет работать):
[vba]

Код

If iArr <> "" Then .Add iArr, Application.WorksheetFunction.Trim(iArr)

Код

[/vba]
Но применение предварительного копирования из диапазона в массив ускоряет работу почти в 5 раз!Alex_ST

С уважением,
Алексей
MS Excel 2003 - the best!!!

Сообщение отредактировал Alex_ST - Четверг, 26.08.2010, 20:56

Ответить

Сообщение=======================================================
Функция (UDF) "СЧЁТ_РАЗНЫХ"
=======================================================
Данная Определенная пользователем функция (User-Defined Function или UDF) возвращает в ячейку листа, куда она введена, число уникальных значений в указанном диапазоне:
[vba]

Код

If iArr <> "" Then .Add iArr, Trim(iArr)

[/vba]
можно написать:
[vba]

Код

If iArr <> "" Then .Add iArr, Application.Trim(iArr)

[/vba]
или (если не будет работать):
[vba]

Код

If iArr <> "" Then .Add iArr, Application.WorksheetFunction.Trim(iArr)

Код

[/vba]
Но применение предварительного копирования из диапазона в массив ускоряет работу почти в 5 раз!

Автор - Alex_ST
Дата добавления - 26.08.2010 в 10:30

Alex_ST

Дата: Понедельник, 04.10.2010, 21:35 | Сообщение № 2

Группа: Друзья

Ранг: Участник клуба

Сообщений: 3213

Репутация: 609 ±

Замечаний: 0% ±

2003

Используя словари (Dictionary), эту UDF можно ещё больше упростить так:
[vba]

Код

Function СЧЁТ_РАЗНЫХ(Диапазон As Range) As Long
     '---------------------------------------------------------------------------------------
     ' Procedure    : СЧЁТ_РАЗНЫХ
     ' Author       : Alex_ST
     ' Purpose      : возвращает число уникальных значений в указанном диапазоне
     '---------------------------------------------------------------------------------------
     Dim iArr, Arr(): Arr = Intersect(Диапазон.Parent.UsedRange, Диапазон).Value
     With CreateObject("Scripting.Dictionary")
        .CompareMode = vbTextCompare   ' Создаем словарь
        For Each iArr In Arr
           If Trim(iArr) <> "" Then iArr = .Item(Trim(iArr))   'попытка чтения значения по отсутствующему ключу добавит ключ в словарь
        Next
        СЧЁТ_РАЗНЫХ = .Count
     End With
End Function

[/vba]

С уважением,
Алексей
MS Excel 2003 - the best!!!

Ответить

Функция (UDF) "СЧЁТ_РАЗНЫХ" (Возвращает число уникальных значений в диапазоне)

Страница 1 из 1
1