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

Вход

Регистрация

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

 

= Мир MS Excel/Готовые решения

МЕНЮ САЙТА
  • 1
  • 2
  • 3

КАТЕГОРИИ РАЗДЕЛА

ОПРОСЫ
Какой версией Excel Вы пользуетесь?
Всего ответов: 35774
Главная » Готовые решения » VBA » Пользовательские функции

Получение уникальных значений из диапазона
09.09.2013, 09:53
[ Файл-пример (16.5Kb) ]

Option Compare Text

Public Function GetDistinct(rng As Range, Optional Trnsp As Boolean = True) As Variant()
Dim x, arr(), v, s As String, i As Long
x = Intersect(rng, rng.Worksheet.UsedRange).Value
ReDim arr(UBound(x)): s = "~"
For Each v In Intersect(rng, rng.Worksheet.UsedRange).Value
 If Len(v) Then
 If InStr(s, "~" & v & "~") = 0 Then
 s = s & v & "~": arr(i) = v: i = i + 1
 End If
 End If
Next
GetDistinct = IIf(Trnsp, WorksheetFunction.Transpose(arr), arr())
End Function
Добавил: nilem | | Теги: ВБА, уникальные, unique from range, диапазон, VBA
Просмотров: 7800 | Рейтинг: 5.0/1
Всего комментариев: 3
+1   Спам
1    MCH   (26.09.2013 23:46)
   Николай, а не проще ли на словарях сделать? при большом количестве уникальных данных InStr и конкатенация будет сильно тормозить, да и Transpose с массивами более чем в 65536 элементов не работает, а у тебя массив определяется не по количеству уникальных, а по количеству исходных данных, при этом т.к. используется IIf, Transpose выполняется в любом случае.

вот так должно быстрее работать
Public Function GetDistinct(rng As Range, Optional Trnsp As Boolean = True) As Variant()
Dim v
With CreateObject("Scripting.Dictionary")
For Each v In Intersect(rng, rng.Worksheet.UsedRange).Value
If Len(v) Then .Item(v) = 0
Next v
If Trnsp Then GetDistinct = WorksheetFunction.Transpose(.keys) Else GetDistinct = .keys
End With
End Function

0   Спам
2    nilem   (03.10.2013 00:01)
   Насчет Transpose согласен. Но УДФ все же не используют для слишком больших диапазонов; если данных сотни тысяч строк, то любая функция будет тормозить.
По поводу InStr и & - не такие уж они и медленные.
а словари просто надоели :)

0   Спам
3    SvetaS   (22.09.2015 15:16)
   добрый День! Николай, у меня почему-то не работает на 300 000 строк.Не подскажите почему? Комп просто висит...

Добавлять комментарии могут только зарегистрированные пользователи.
[ Регистрация | Вход ]
Яндекс цитирования
© 2010-2016 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!