Функция UniqueValuesFromArray позволяет найти в указанном столбце двумерного массива все уникальные значения, и получить новый массив, содержащий все найденные уникальные значения. Private Sub UserForm_Initialize() On Error Resume Next: arr = PriceRange.Value If Err Then MsgBox "Нет строк для обработки!", vbCritical, "Ошибка": End ' заполняем комбобокс уникальными значениями из 6-го столбца таблицы Me.ComboBox_Source.List = UniqueValuesFromArray(arr, 6) End Sub Код самой функции: Function UniqueValuesFromArray(ByVal arr, ByVal col As Long) As Variant ' перебирает все значения в столбце Col двумерного массива arr ' в поисках уникальных значений. Возвращает двумерный вертикальный массив ' размерностью N * 1, содержащий уникальные значения из столбца col If Not IsArray(arr) Then MsgBox "Это не массив!", vbCritical: Exit Function If col > UBound(arr, 2) Then MsgBox "Нет такого столбца в массиве!", vbCritical: Exit Function If col < LBound(arr, 2) Then MsgBox "Нет такого столбца в массиве!", vbCritical: Exit Function On Error Resume Next: Dim coll As New Collection, txt$ For i = LBound(arr) To UBound(arr) txt$ = Trim(arr(i, col)): coll.Add txt$, txt$ Next i ReDim newarr(1 To coll.Count, 1 To 1) For i = 1 To coll.Count: newarr(i, 1) = coll(i): Next i UniqueValuesFromArray = newarr End Function Во вложении - пример использования этой функции в макросе (вывод уникальных записей в другой столбец листа), и пользовательская функция Уникальные - для использования в формулах листа Excel. Макрос и дополнительная функция из файла во вложении: Sub ВыборкаУникальных() ' берем диапазон ячеек из первого столбца активного листа Dim ПервыйСтолбец As Range: Set ПервыйСтолбец = Range([A1], Range("A" & Rows.Count).End(xlUp)) ' выбираем из него уникальные значения МассивУникальных = UniqueValuesFromArray(ПервыйСтолбец.Value, 1) ' и заносим их в другой столбец, начиная с ячейки D1 Range("D1").Resize(UBound(МассивУникальных)).Value = МассивУникальных End Sub ' пользовательская функция - для использования в качестве формулы массива Function Уникальные(ByVal ra As Range) As Variant ' перебирает все значения в диапазоне ra в поисках уникальных значений. ' Возвращает двумерный массив, содержащий уникальные значения из диапазона ra On Error Resume Next: Dim cell As Range, coll As New Collection, txt$ For Each cell In ra.Cells txt$ = Trim(cell): If Len(txt$) Then coll.Add txt$, txt$ Next cell ReDim newarr(1 To coll.Count, 1 To 1) For i = 1 To coll.Count: newarr(i, 1) = coll(i): Next i Уникальные = newarr End Function
|
|||||||
Комментарии
Здравствуйте EducatedFool (Игорь). Мне очень понравилась ваша функция (
Извлечение уникальных значений из диапазона ячеек или массива), но меня еще больше заинтересовал ответ #3, в котором прикреплен пример (Пример в файле: http://excelvba.ru/XL_Files/Sample__21-08-2011__17-14-22.zip).
Вопрос по данной функции, а можно сделать чтобы поиск уникальных значений ввелся с конца массива? И значение записывалось первое найденное в конце массива?
Спасибо за ответ
Да, пример Sample__21-08-2011__17-14-22.zip - самое то.
Еще раз большое спасибо!
Спасибо. Буду изучать.
Так сделать можно, но...
одно дело - выбрать уникальные значения (тут всё ясно, вариантов особо нет),
и совсем другое - выбрать строки с уникальными значениями в каком-то столбце.
К примеру, есть у нас 3 строки с одинаковыми значениями в 1-м столбце.
Какую из этих трёх строк выводить в результат? Первую, третью, вторую?
Вообще, у меня есть уже такая функция (даже с большей функциональностью, чем вам требуется):
http://excelvba.ru/code/JoinedArray
Пример её использования для вашего случая:
arr = JoinedArray(Массив, 1)
Пример в файле: http://excelvba.ru/XL_Files/Sample__21-08-2011__17-14-22.zip
Извините за надоедливость ))
Возни еще один вопрос.
Сейчас выборка уникальный происходит только по столбцу "A".
Возможно ли сделать выборку уникальных по столбцу "A", но с условием, чтобы в диапазон фильтрования попадали также столбцы B и C ?
Т.е. чтобы был аналог функционалу Excel 2007: Выделяю столбцы A,B,C => Данные => Удалить дубликаты => В качестве столбца, по которому будет происходить удаление дубликатов выбираю только столбец A.
Как результат: уникальные значения будут отобраны по столбцу "А", но соответствующие записи из столбцов B и C будут также сохранены.
Вроде разобрался:
Dim ПервыйСтолбец As Range: Set ПервыйСтолбец = Range(Sheets("данные").Range("A1"), Sheets("данные").Range("A" & Rows.Count).End(xlUp))
Здравствуйте!
Подскажите, пожалуйста. Сейчас макрос срабатывает в случае если активен лист с массивом.
Как правильно добавить название листа в запись, чтобы активация листа с массивом не была обязательной?
Я пробовал вот так, но макрос выдает ошибку:
Dim ПервыйСтолбец As Range: Set ПервыйСтолбец = Sheets("данные").Range([A1], Sheets("данные").Range("A" & Rows.Count).End(xlUp))
все прекрасно, только не совсем понятно, что происходит.. вот был бы файлик с работающим примером, там хоть по результату можно было б вычислить, что-куда
Отличный пример использования коллекций для создания массива уникальных записей. Давно использую коллекции, но до этого сам не додумался. И работает быстро ))
Отправить комментарий