Домашняя страница Undo Do New Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/Функция (UDF) "ЭЛЕМЕНТ_СПИСКА" - Мир MS Excel

Старая форма входа
  • Страница 1 из 1
  • 1
Модератор форума: _Boroda_, китин  
Мир MS Excel » Вопросы и решения » Готовые решения » Функция (UDF) "ЭЛЕМЕНТ_СПИСКА" (Возвращает N-ное из уникальных значений в диапазоне)
Функция (UDF) "ЭЛЕМЕНТ_СПИСКА"
Alex_ST Дата: Четверг, 26.08.2010, 10:36 | Сообщение № 1
Группа: Друзья
Ранг: Участник клуба
Сообщений: 3206
Репутация: 609 ±
Замечаний: 0% ±

2003
=======================================================
Функция (UDF) "ЭЛЕМЕНТ_СПИСКА"
=======================================================
Данная Определенная пользователем функция (User-Defined Function или UDF) возвращает в ячейку листа, куда она введена, N-ное из уникальных значений в указанном диапазоне:
[vba]
Код

Function ЭЛЕМЕНТ_СПИСКА(Диапазон As Range, Номер_элемента As Integer)
     '---------------------------------------------------------------------------------------
     ' Procedure    : ЭЛЕМЕНТ_СПИСКА
     ' Author       : Alex_ST & The_Prist & Лузер™
     ' Topic_HEADER : Функция СЧЁТ_РАЗНЫХ (UDF)
     ' Topic_URL    : http://www.planetaexcel.ru/forum.php?thread_id=15009&useraction=login
     ' Post_Author  :
     ' Post_URL     :
     '---------------------------------------------------------------------------------------
     Dim TmpArr(), iArr
     TmpArr = Intersect(Диапазон.Parent.UsedRange, Диапазон).Value
     Set Диапазон = Intersect(Диапазон.Parent.UsedRange, Диапазон)
     On Error Resume Next
     With New Collection
        For Each iArr In TmpArr
           If iArr <> "" Then .Add Trim(iArr), Trim(CStr(iArr))
        Next
        If Номер_элемента >= 1 And Номер_элемента <= .Count Then
           ЭЛЕМЕНТ_СПИСКА = .Item(Номер_элемента)
        Else
           ЭЛЕМЕНТ_СПИСКА = "#Н/Д"
        End If
     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. Поэтому можно указывать целиком столбец, не опасаясь больших "тормозов".


С уважением,
Алексей
MS Excel 2003 - the best!!!
 
Ответить
Сообщение=======================================================
Функция (UDF) "ЭЛЕМЕНТ_СПИСКА"
=======================================================
Данная Определенная пользователем функция (User-Defined Function или UDF) возвращает в ячейку листа, куда она введена, N-ное из уникальных значений в указанном диапазоне:
[vba]
Код

Function ЭЛЕМЕНТ_СПИСКА(Диапазон As Range, Номер_элемента As Integer)
     '---------------------------------------------------------------------------------------
     ' Procedure    : ЭЛЕМЕНТ_СПИСКА
     ' Author       : Alex_ST & The_Prist & Лузер™
     ' Topic_HEADER : Функция СЧЁТ_РАЗНЫХ (UDF)
     ' Topic_URL    : http://www.planetaexcel.ru/forum.php?thread_id=15009&useraction=login
     ' Post_Author  :
     ' Post_URL     :
     '---------------------------------------------------------------------------------------
     Dim TmpArr(), iArr
     TmpArr = Intersect(Диапазон.Parent.UsedRange, Диапазон).Value
     Set Диапазон = Intersect(Диапазон.Parent.UsedRange, Диапазон)
     On Error Resume Next
     With New Collection
        For Each iArr In TmpArr
           If iArr <> "" Then .Add Trim(iArr), Trim(CStr(iArr))
        Next
        If Номер_элемента >= 1 And Номер_элемента <= .Count Then
           ЭЛЕМЕНТ_СПИСКА = .Item(Номер_элемента)
        Else
           ЭЛЕМЕНТ_СПИСКА = "#Н/Д"
        End If
     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. Поэтому можно указывать целиком столбец, не опасаясь больших "тормозов".
Автор - Alex_ST
Дата добавления - 26.08.2010 в 10:36
Alex_ST Дата: Понедельник, 04.10.2010, 21:36 | Сообщение № 2
Группа: Друзья
Ранг: Участник клуба
Сообщений: 3206
Репутация: 609 ±
Замечаний: 0% ±

2003
Используя словари (Dictionary), эту UDF можно ещё больше упростить так:
[vba]
Код
Function УНИКАЛЬНЫЙ_ЭЛЕМЕНТ(Диапазон As Range, Номер_элемента As Integer)
     '---------------------------------------------------------------------------------------
     ' Procedure    : УНИКАЛЬНЫЙ_ЭЛЕМЕНТ
     ' Author       : Alex_ST
     ' Purpose      : возвращает N-ное из уникальных значений в указанном диапазоне
     '---------------------------------------------------------------------------------------
     Dim iArr, Arr(): Arr = Intersect(Диапазон, Диапазон.Parent.UsedRange.Cells.SpecialCells(xlCellTypeVisible)).Value
     With CreateObject("Scripting.Dictionary")
        .CompareMode = vbTextCompare   ' Создаем словарь
        For Each iArr In Arr
           If Trim(iArr) <> "" Then iArr = .Item(Trim(iArr))   'попытка чтения значения по отсутствующему ключу добавит ключ в словарь
        Next
        Arr = .Keys   ' массив ключей крпируем в массив
        If Номер_элемента >= 1 And Номер_элемента <= .Count Then
           УНИКАЛЬНЫЙ_ЭЛЕМЕНТ = Arr(Номер_элемента - 1)
        Else
           УНИКАЛЬНЫЙ_ЭЛЕМЕНТ = "#Н/Д"
        End If
     End With
End Function
[/vba]


С уважением,
Алексей
MS Excel 2003 - the best!!!
 
Ответить
СообщениеИспользуя словари (Dictionary), эту UDF можно ещё больше упростить так:
[vba]
Код
Function УНИКАЛЬНЫЙ_ЭЛЕМЕНТ(Диапазон As Range, Номер_элемента As Integer)
     '---------------------------------------------------------------------------------------
     ' Procedure    : УНИКАЛЬНЫЙ_ЭЛЕМЕНТ
     ' Author       : Alex_ST
     ' Purpose      : возвращает N-ное из уникальных значений в указанном диапазоне
     '---------------------------------------------------------------------------------------
     Dim iArr, Arr(): Arr = Intersect(Диапазон, Диапазон.Parent.UsedRange.Cells.SpecialCells(xlCellTypeVisible)).Value
     With CreateObject("Scripting.Dictionary")
        .CompareMode = vbTextCompare   ' Создаем словарь
        For Each iArr In Arr
           If Trim(iArr) <> "" Then iArr = .Item(Trim(iArr))   'попытка чтения значения по отсутствующему ключу добавит ключ в словарь
        Next
        Arr = .Keys   ' массив ключей крпируем в массив
        If Номер_элемента >= 1 And Номер_элемента <= .Count Then
           УНИКАЛЬНЫЙ_ЭЛЕМЕНТ = Arr(Номер_элемента - 1)
        Else
           УНИКАЛЬНЫЙ_ЭЛЕМЕНТ = "#Н/Д"
        End If
     End With
End Function
[/vba]
Автор - Alex_ST
Дата добавления - 04.10.2010 в 21:36
Мир MS Excel » Вопросы и решения » Готовые решения » Функция (UDF) "ЭЛЕМЕНТ_СПИСКА" (Возвращает N-ное из уникальных значений в диапазоне)
  • Страница 1 из 1
  • 1
Поиск:

Яндекс.Метрика Яндекс цитирования
© 2010-2024 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!