Функция UniqueValuesFromArray позволяет найти в указанном столбце двумерного массива все уникальные значения, и получить новый массив, содержащий все найденные уникальные значения.
Это может пригодиться, если надо, к примеру, заполнить ComboBox на форме возможными вариантами значений из базы данных:
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
Комментарии
Благодарю за Вашу работу. Столкнулся с проблемой выборки дубликатов из массива около 80000 строк и записью строки из 6 значений другого массива на лист ошибок. Решил вопрос доработкой функции UniqueValuesFromArray плюс быстрый поиск ArraySearchResults. Временные показатели очень порадовали 40 секунд вместо 10 минут перебора и выборки из другого массива. Прошу дополнить страницу или создать новую с функцией DoubleValuesFromArray (Поиск уникальных ПОВТОРЯЮЩИХСЯ значений в массиве)
Еще раз спасибо за Вашу работу. Выручали не раз.
Игорь, спасибо!
Подскажите, как доработать функцию так, чтобы уникальные значения переносились в том формате, в котором они находились в начальном массиве? В моем случае начальный массив - это числа, которые выгружаются из другой программы и не отформатированы, как числа, в то время, как переносятся они в виде чисел. Из-за этого в последствии не работает функция ВПР.
Или может быть лучше сделать так, чтобы функция сначала преобразовывала начальный массив в числа и только потом переносила уникальные?
Это потому что вы в другой файл перенесли только часть кода (а код функции UniqueValuesFromArray забыли скопировать)
Добрый день!
На родном файле макрос работает отлично, на другом, с тем же расширением не работает, выдает ошибку Sub or Function not defined на UniqueValuesFromArray. В чем может быть причина?
Расширения обоих файлов поменял на .xlsm
Спасибо!
РАЗОБРАЛСЯ!!!!!
СПАСИБО БОЛЬШОЕ ЗА ФУНКЦИЮ1111111
Нет.
выглядит так:
А B
1 текст 1 текст 1
2 текст 2 текст 2
3 текст 3 текст 3
4 текст 4 текст 4
5 текст 5 текст 5
6 текст 6 текст 6
7 текст 7 текст 7
...
33 текст 33 текст 33
34 текст 34 текст 34
35 текст 35 текст 1
36 текст 36 текст 1
37 текст 37 текст 1
и так делее
Т.е. в столбце А я вставил только уникальные значения до строки 80 (текст 80), но на 35 строке функция перестает работать как-будто, может я что не так сделал?
Помогите пожалуйста, я могу это сделать формулами, ног проблема в нагрузке, в моем файле просматриваемый массив имеет длину 2000 строк, excel умирает на расчетах.(((((
Видимо, 36-е значение (которое «первое уникальное») - только с виду похоже на первое
(например, есть лишний пробел, или одна русская буква заменена похожей английской)
Сравнить посимвольно 2 ячейки можно этой надстройкой:
http://excelvba.ru/tools/CharCodes
Добрый день.
Сразу скажу, что в макросах не че не понимаю.
Мне очень понравилась ваша функция, но появилась проблема.
Функция выбирает 35 уникальных значений, далее возвращает первое уникальное.
В чем проблема?
В статье написано:
выделяете НЕСКОЛЬКО ячеек, вводите эту формулу, и завершаете ввод нажатием Ctrl + Shift + Enter (вместо обычного Enter)
Тогда будет выводиться несколько уникальных значений
А вообще, уникальные можно и формулами вывести, без макросов.
Доброго времени суток. Макрос у меня заработал отлично а вот функция "Уникальные" почему то работает только в файле примере Unique.xls. Ситуация такая: все как положено добавил функцию в модуль, но она на отрез отказывается корректно работать, вместо уникальных значений выдает первое попавшееся значение причем оно возвращается во всех ячейках где прописана функция. Помогите пожалуйста разобраться.
Не знаю, увидите ли вы, но спасибо!
И автору тоже!
Добрый вечер. Разбираю макрос, который здесь представлен. С VBA не работала. Можно ли усложнить функцию вывода уникальных: вывод за период временной с исключением каких-то уникальных значений, т.е. возможно это значение встречается в этот период несколько раз, но выводить его не надо, так как не интересно. Буду очень благодарна за помощь
замените строку
на
Добрый день. Разбираю сейчас Ваш макрос. Не сильна в них. Прошу помочь. В целом все работает отлично, но не могу понять как поменять его, чтобы новый массив уникальных вставал на другой (заданный) лист и не столбцом, а строкой. Буду очень признательна за помощь.
Тут самое главное, вот это: On Error Resume Next: Dim coll As New Collection
то есть при ошибке продолжить заполнение коллекции, а так как в коллекцию добавляется ключ такой же как и само значение
txt$ = Trim(cell): If Len(txt$) Then coll.Add txt$, txt$ 'коллекция.добавить значение, ключ
то в коллекции автоматически остается только один уникальный ключ, по определению, и вместе с ним одно уникальное значение
Владимир, ваш вопрос не имеет никакого отношения к теме статьи
В вашем случае, макросы не нужны, - достаточно одной формулы
Обратитесь на любой форум по Excel, прикрепив пример файла, - вам помогут с формулой.
Здравствуйте!
Давно пытаюсь найти решение подобной задачи. Знаний к сожалению не хватает. И вот нашёл Ваш пример. У меня задача хоть и подобная но масштабы больше. В одной книге есть 2 листа:
1 лист (таблица заказов) имеет 159 столбцов с данными, 165 столбец с датой. Каждый столбец с данными пронумерован № продукции 0001,0002,0003, и т.д.0159.
2 лист (отчёт) В отчёте 2 столбец №-ра продукции построчно и 4 столбец для копирования данных продукции с 1 листа.
И вот надо решить задачу: как выбрать продукцию с 1 листа и скопировать во 2 лист по определённой дате заданной во 2 листе.
Вроде бы кажется, что всё просто, но ничего не получается. Прошу Вас подскажите как всё это решить.
Спасибо большое! Действительно быстро работает.
Единственное, что добавил - пропуск пустых ячеек:
For i = LBound(arr) To UBound(arr)
If Trim(arr(i, col)) = "" Then GoTo 1
txt$ = Trim(arr(i, col)): coll.Add txt$, txt$
1: Next i
Вопрос не актуален.
Прочитал ниже, что мне надо использовать http://excelvba.ru/code/JoinedArray
Function UniqueValuesFromArray может возвращать массив размерностью исходного массива, а не размерностью N * 1?
В дополнительном столбце, при помощи формулы типа =СЦЕПИТЬ(A1;"//";B1), объедините значения этих 2 столбцов,
и потом по этому доп.столбцу отбирайте уникальные
Подскажите пожалуйста, как изменить ваши процедуры, чтобы можно было выбрать уникальные значения не одного столбца, а нескольких. Например в Стобце A значения а,в,а,в. В столбце B в соседних ячейках значения с,д,с,е. Нужно чтобы макрос вдавал массив: В первом столбце: а,в,в. В соседнем с,д,е.
Спасибо! Очень помогло!!!
Спасибо за функцию.
Работает отлично.
Это уже вторая Ваша функция в течение двух дней, которую я применил в своей работе.
Завтра еще третью буду пробовать - поиск в массиве :)
Здравствуйте 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))
все прекрасно, только не совсем понятно, что происходит.. вот был бы файлик с работающим примером, там хоть по результату можно было б вычислить, что-куда
Отличный пример использования коллекций для создания массива уникальных записей. Давно использую коллекции, но до этого сам не додумался. И работает быстро ))
Отправить комментарий