Функция UniqueValues возвращает коллекцию, содержащую уникальные непустые значения из диапазона ячеек (или массива) Function UniqueValues(ByVal arr) As Collection ' функция получает в качестве параметра массив любой размерности ' возвращает коллекцию уникальных НЕПУСТЫХ значений Set UniqueValues = New Collection: On Error Resume Next For Each v In arr v = Trim(v): If Len(v) Then UniqueValues.Add CStr(v), CStr(v) Next v End Function Sub ПримерИспользования_UniqueValues() For Each v In UniqueValues([a3:b6500].Value) Debug.Print v Next End Sub Если же требуется найти уникальные значения в массиве из нескольких столбцов, или получить результат (уникальные значения) в виде массива (для последующей записи на лист, или в элемент управления типа ComboBox или ListBox), то используйте функцию UniqueValuesFromArray: (добавлено) Function UniqueValuesFormRange(ByVal ra As Range) As Collection ' функция получает в качестве параметра диапазон ячеек ' возвращает коллекцию уникальных НЕПУСТЫХ значений Set UniqueValuesFormRange = New Collection: On Error Resume Next Dim ar As Range For Each ar In ra.Areas For Each v In ar.Value v = Trim(v): If Len(v) Then UniqueValuesFormRange.Add CStr(v), CStr(v) Next v Next ar End Function Пример её использования: Sub ПримерИспользования_UniqueValuesFormRange() For Each v In UniqueValuesFormRange(Selection) Debug.Print v Next End Sub
|
|||
Комментарии
Выложил пример в статье Извлечение уникальных значений из диапазона ячеек или массива
Как это использовать? Я скопировал код в созданный модуль VBA, потом, через пользовательские функции запускаю функцию, выделяю диапазон массива, жму ввод и получаю облом в виде #ЗНАЧ!
Спасибо! Очень помогло!
Дольше искал в хелпе, куда возвращает список )
Вы съэкономили мне сутки жизни.
Благодарю.
Отправить комментарий