Hellmaster Пользователь Сообщений: 208 |
#1 09.10.2019 10:57:28 Добрый день.
Прикрепленные файлы
|
||
IKor Пользователь Сообщений: 1167 |
Знакома ли Вам эта статья? Подсчет количества уникальных значений Если Вы настаиваете на решении при помощи макросов, то попробуйте реализовать на VBA логику работы формул, представленных в статье. |
Jack Famous Пользователь Сообщений: 10852 OS: Win 8.1 Корп. x64 | Excel 2016 x64: | Browser: Chrome |
#3 09.10.2019 11:13:27 Hellmaster, здравствуйте!
словари не имеют конкуренции на массивах до 100 000 уникальных элементов. Потом начинают проигрывать варианту с предварительной сортировкой Прикрепленные файлы
Изменено: Jack Famous — 09.10.2019 11:28:11 Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄ |
|||
IKor Пользователь Сообщений: 1167 |
Offtopic: |
IKor, спасибо за статью, возьму на вооружение. |
|
Jack Famous Пользователь Сообщений: 10852 OS: Win 8.1 Корп. x64 | Excel 2016 x64: | Browser: Chrome |
#6 09.10.2019 12:24:34 IKor, я не понял вашей аллегории (применительно к данному вопросу) холиваре по сравнению эффективности и универсальности между ними я на стороне словарей.
в файле я подключил нужную библиотеку — советую в вашем также сделать. Ну или использовать позднее связывание . Будет медленнее, но разницу вы вряд ли заметите: Изменено: Jack Famous — 09.10.2019 12:33:12 Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄ |
||
Jack Famous, спасибо. все работает |
|
Jack Famous Пользователь Сообщений: 10852 OS: Win 8.1 Корп. x64 | Excel 2016 x64: | Browser: Chrome |
Hellmaster, пользуйтесь на здоровье и обязательно посмотрите ссылки UPD: Разместил тут более универсальный макрос-отчёт Изменено: Jack Famous — 09.10.2019 16:00:37 Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄ |
IKor Пользователь Сообщений: 1167 |
#9 10.10.2019 10:35:01
Для меня макросы — темный лес, на который я смотрю в лучшем случае с опушки… |
||
Jack Famous Пользователь Сообщений: 10852 OS: Win 8.1 Корп. x64 | Excel 2016 x64: | Browser: Chrome |
#10 10.10.2019 11:08:08
1. простота — понятие относительное, не так ли? В данном случае моё готовое решение в 1 щелчок позволяет получить нужную информацию без доп. столбцов с формулами. Вот мне кажется, что именно так намного быстрее и удобнее (а в расширенной версии по ссылке вообще полноценный отчёт получается) Считаю, что дополнительные альтернативные варианты редко бывают лишними и ваша ссылка вполне уместна Изменено: Jack Famous — 10.10.2019 11:08:34 Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄ |
||
IKor Пользователь Сообщений: 1167 |
#11 10.10.2019 11:25:52
Пожалуйста, не приписывайте мне действий, которые я не совершал. |
||
Oleg OK Пользователь Сообщений: 13 |
#12 07.02.2023 21:08:46 Jack Famous, Добрый вечер! имеется столбец с значениями с помощью кода найденного на этом прекрасном форуме удалось решить задачку по подсчету уникальных значений.
Так же вопрос по этой строке «If Len(arr) Then x = dic(arr)» как я понимаю тут подсчитывается кол-во байтов, и если оно совпадает с значением в словаре, то не записывается. Верно? вопрос что за переменная X и почему ее значение всегда равно ПУСТОТЕ. Заранее спасибо! Прикрепленные файлы
Изменено: Oleg OK — 07.02.2023 21:09:33 |
||
Ігор Гончаренко Пользователь Сообщений: 13746 |
#13 07.02.2023 21:44:08
на военной кафедре: Программисты — это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете! |
||
Hugo Пользователь Сообщений: 23253 |
1) Порядок в словаре не регламентируется, поэтому такой запрос по сути не имеет смысла. Но физически там конечно есть первое значение… Чтоб найти самое часто встречающееся — можно например записывать в словарь количество повторений ключа, и сразу максимально полученное число запоминать в переменную. Можно с ключём. |
Ігор Гончаренко Пользователь Сообщений: 13746 |
#15 07.02.2023 22:01:12
Программисты — это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете! |
||
Oleg OK Пользователь Сообщений: 13 |
#16 08.02.2023 08:31:34
Спасибо улыбнуло) Я понимаю что Х от Y и даже от «И краткой» не отличается ничем) Вопрос что она делает в коде выше. Не могу понять мы считаем длину строки и в переменную Х записываем слово которое сейчас в перебираемой ячейке? О_о а почему Х всегда пустой, как бы я не бегал по нему пошаговым выполнением макроса =(
Простите, что докапываюсь «школьными» вопросами.
|
||||
Jack Famous Пользователь Сообщений: 10852 OS: Win 8.1 Корп. x64 | Excel 2016 x64: | Browser: Chrome |
#17 08.02.2023 10:14:38
ошибочное заявление. при получении массивов из коллекций ключей и значений словаря они по индексам соответствтвуют друг-другу и порядку добавления в словарь Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄ |
||
After reading through this and then investigating further, I’ve got one that works better for me than anything I see here:
Array-enter:
(Ctrl+Shift+Enter, and don’t include the curly brackets)
{=SUM(IFERROR(1/COUNTIF(C2:C2080,C2:C2080),0))}
Or in VBA:
MyResult = MyWorksheetObj.Evaluate("=SUM(IFERROR(1/COUNTIF(C2:C2080,C2:C2080),0))")
It works for both numbers and text, it handles blank cells, it handles errors in referenced cells, and it works in VBA. It’s also one of the most compact solutions I’ve seen. Using it in VBA, it apparently automatically handles the need to be an array formula.
Note, the way it handles errors is by simply including them in the count of uniques. For example, if you have two cells returning #DIV/0! and three cells returning #VALUE!, those 5 cells would add 2 to the final count of unique values. If you want errors completely excluded, it would need to be modified for that.
In my tests, this one from Jacob above only works for numbers, not text, and does not handle errors in referenced cells (returns an error if any of the referenced cells returns an error):
=SUM(IF(FREQUENCY(G4:G29,G4:G29)>0,1))
Bati4eli 615 / 15 / 8 Регистрация: 05.05.2012 Сообщений: 221 Записей в блоге: 11 |
||||
1 |
||||
Количество уникальных значений по условию16.04.2013, 12:14. Показов 19049. Ответов 39 Метки нет (Все метки)
Привет, всем!
0 |
1121 / 229 / 36 Регистрация: 15.03.2010 Сообщений: 698 |
|
16.04.2013, 13:38 |
2 |
Расширенный фильтр не подойдет? Поставить пустое условие и галку на уникальных значениях. Потом посчитать видимые строки, если фильтровать на месте.
0 |
81 / 24 / 2 Регистрация: 18.01.2013 Сообщений: 74 |
|
16.04.2013, 13:48 |
3 |
можно так: =ЕСЛИ(И(СЧЁТЕСЛИ(B:B;B2)=1;C2=$C$1);1;0) B:B — столбец в котором значение должно быть уникальным протянуть формулу на весь столбец и посчитать получившуюся сумму….
0 |
KoGG 5590 / 1580 / 406 Регистрация: 23.12.2010 Сообщений: 2,366 Записей в блоге: 1 |
||||
16.04.2013, 14:18 |
4 |
|||
Замени с 23 по 44 строку, будет быстрее:
1 |
Bati4eli 615 / 15 / 8 Регистрация: 05.05.2012 Сообщений: 221 Записей в блоге: 11 |
||||
16.04.2013, 15:07 [ТС] |
5 |
|||
Вот я дурак.. я думал, что этот цикл в цикле не особо увеличит время работы!
Единственный вопрос: почему у меня не выводится массив на листе, когда я использую метод в функции «МАССИВ_УНИ» ?
0 |
KoGG 5590 / 1580 / 406 Регистрация: 23.12.2010 Сообщений: 2,366 Записей в блоге: 1 |
||||||||||||
16.04.2013, 15:38 |
6 |
|||||||||||
Если диапазон «Диапазон» из одной колонки, то
Да и RC вовсе не нужна.
Добавлено через 21 минуту Кликните здесь для просмотра всего текста
Добавлено через 5 минут
0 |
6875 / 2807 / 533 Регистрация: 19.10.2012 Сообщений: 8,562 |
|
16.04.2013, 21:27 |
7 |
Если не работать с ячейками — будет ещё раз так в 40 быстрее…
0 |
615 / 15 / 8 Регистрация: 05.05.2012 Сообщений: 221 Записей в блоге: 11 |
|
17.04.2013, 13:21 [ТС] |
8 |
Hugo121,
Если не работать с ячейками — будет ещё раз так в 40 быстрее… Как можно не работать с ячейками?
0 |
615 / 15 / 8 Регистрация: 05.05.2012 Сообщений: 221 Записей в блоге: 11 |
|
17.04.2013, 13:28 [ТС] |
9 |
KoGG, Посмотрите, пожалуйста, пример из предыдущего сообщения. (Там используется старая функция)
0 |
Казанский 15136 / 6410 / 1730 Регистрация: 24.09.2011 Сообщений: 9,999 |
||||
17.04.2013, 15:06 |
10 |
|||
Лучше создать функцию, которая вводится в столбец как формула массива и возвращает массив.
Функцию надо вводить в столбец С4:С282 с помощью Ctrl+Shift+Enter. Расчет занимает доли секунды, результат совпадает с существующим: Код =СЧЕТ_УСЛ(ИСТОЧНИК!A:A;A4:A282;ИСТОЧНИК!B:B)
1 |
5590 / 1580 / 406 Регистрация: 23.12.2010 Сообщений: 2,366 Записей в блоге: 1 |
|
17.04.2013, 17:44 |
11 |
Кстати, оптимальнее всего в данной задаче вообще убрать функцию, а на листе источник рядом с суммой добавить колонку численность, и по всей колонке проставить 1. В сводной таблице добавить поле колонки численность и она будет суммироваться.
0 |
5590 / 1580 / 406 Регистрация: 23.12.2010 Сообщений: 2,366 Записей в блоге: 1 |
|
17.04.2013, 18:09 |
12 |
А вот тестовый пример, где работают три метода. При вызове множества функций из сводной таблицы время будет другое, если заново формируется сводная таблица, то возможно пересчитываться будет каждая из 282 введенных, тут функция массива Казанского с сумме будет быстрее. А еще оптимальнее — смотри выше.
0 |
5590 / 1580 / 406 Регистрация: 23.12.2010 Сообщений: 2,366 Записей в блоге: 1 |
|
17.04.2013, 18:15 |
13 |
Офис 2007, Windows 8, процессор Intel(R) Core(TM) i7 CPU 930 @ 2.8 GHz, Оперативка 4 Гб.
0 |
Bati4eli 615 / 15 / 8 Регистрация: 05.05.2012 Сообщений: 221 Записей в блоге: 11 |
||||
17.04.2013, 22:37 [ТС] |
14 |
|||
Кстати, оптимальнее всего в данной задаче вообще убрать функцию, а на листе источник рядом с суммой добавить колонку численность, и по всей колонке проставить 1. В сводной таблице добавить поле колонки численность и она будет суммироваться. К сожалению в том то и дело, что одной сводной здесь не решишь задачу, так как таким методом мы получим не кол-во уникальных людей по одной профессии, а все платежи совершенные по этой профессии. Честно говоря извеняюсь за то, что поднял такую панику Я думал, что этот файл придется перекидывать по предприятию (а вы знаете, что макросы включены не у всех и ошибка типа #ИМЯ введет в ступор непродвинутых людей). Казанский, ваш метод я обязательно завтра испробую. А так написал тупо макрос, выводящий массив профессий и численность рядом с ними. Самый последнейший вопрос:
при вводе её в Excel (как массив) у меня отображается только самый первый элемент массива?
0 |
Аксима 6076 / 1320 / 195 Регистрация: 12.12.2012 Сообщений: 1,023 |
||||
17.04.2013, 22:59 |
15 |
|||
Почему функция
при вводе её в Excel (как массив) у меня отображается только самый первый элемент массива? Одномерный массив в Excel представляется 1 строкой и несколькими столбцами. В данном случае вам надо выделить на листе область из 1 строки и 3 столбцов, в строке формул ввести =MyFunc() и нажать клавиши Ctrl+Shift+Enter.
0 |
615 / 15 / 8 Регистрация: 05.05.2012 Сообщений: 221 Записей в блоге: 11 |
|
18.04.2013, 09:35 [ТС] |
16 |
Aksima, Казанский,
0 |
Аксима 6076 / 1320 / 195 Регистрация: 12.12.2012 Сообщений: 1,023 |
||||
18.04.2013, 09:49 |
17 |
|||
А как представить массив, чтобы он распределялся по строкам, а не столбцам в экселе? Можете попробовать так:
С уважением,
1 |
615 / 15 / 8 Регистрация: 05.05.2012 Сообщений: 221 Записей в блоге: 11 |
|
18.04.2013, 09:59 [ТС] |
18 |
Вот для чего транспонирование в экселе нужно =)
0 |
15136 / 6410 / 1730 Регистрация: 24.09.2011 Сообщений: 9,999 |
|
18.04.2013, 10:01 |
19 |
ваш вариант, не совсем верно считает На примере, который Вы привели в сообщении #8, моя функция дает точно такой же результат, как ваша функция — я выводил в другой столбец и сравнивал.
0 |
615 / 15 / 8 Регистрация: 05.05.2012 Сообщений: 221 Записей в блоге: 11 |
|
18.04.2013, 11:20 [ТС] |
20 |
Казанский,
0 |
Макрос по подсчету уникальных значений |
||||||||
Ответить |
||||||||
Ответить |
||||||||
Ответить |
||||||||
Ответить |
||||||||
Ответить |
||||||||
Ответить |
||||||||
Ответить |
||||||||
Ответить |
||||||||
Ответить |
||||||||
Ответить |
||||||||
Ответить |
||||||||
Ответить |
||||||||
Ответить |
||||||||
Ответить |
||||||||
Ответить |
||||||||
Ответить |
||||||||
Ответить |
||||||||
Ответить |
||||||||
Ответить |
||||||||
Ответить |
Хитрости »
1 Май 2011 532180 просмотров
Как получить список уникальных(не повторяющихся) значений?
Представим себе большой список различных наименований, ФИО, табельных номеров и т.п. А необходимо из этого списка оставить список все тех же наименований, но чтобы они не повторялись — т.е. удалить из этого списка все дублирующие записи. Как это иначе называют: создать список уникальных элементов, список неповторяющихся, без дубликатов. Для этого существует несколько способов: встроенными средствами Excel, встроенными формулами и, наконец, при помощи кода Visual Basic for Application(VBA) и сводных таблиц. В этой статье рассмотрим каждый из вариантов.
- При помощи встроенных возможностей Excel 2007 и выше
- При помощи Расширенного фильтра
- При помощи формул
- При помощи кодов Visual Basic for Application(VBA) — макросы, включая универсальный код выборки из произвольного диапазона
- При помощи сводных таблиц
В Excel 2007 и 2010 это сделать проще простого — есть специальная команда, которая так и называется — Удалить дубликаты (Remove Duplicates). Расположена она на вкладке Данные (Data) подраздел Работа с данными (Data tools)
Как использовать данную команду. Выделяете столбец(или несколько) с теми данными, в которых надо удалить дублирующие записи. Идете на вкладку Данные (Data) —Удалить дубликаты (Remove Duplicates).
Если выделить один столбец, но рядом с ним будут еще столбцы с данными(или хотя бы один столбец), то Excel предложит выбрать: расширить диапазон выборки этим столбцом или оставить выделение как есть и удалить данные только в выделенном диапазоне. Важно помнить, что если не расширить диапазон, то данные будут изменены лишь в одном столбце, а данные в прилегающем столбце останутся без малейших изменений.
Появится окно с параметрами удаления дубликатов
Ставите галочки напротив тех столбцов, дубликаты в которых надо удалить и жмете Ок. Если в выделенном диапазоне так же расположены заголовки данных, то лучше поставить флаг Мои данные содержат заголовки, чтобы случайно не удалить данные в таблице(если они вдруг полностью совпадают со значением в заголовке).
Способ 1: Расширенный фильтр
В случае с Excel 2003 все посложнее. Там нет такого инструмента, как Удалить дубликаты. Но зато есть такой замечательный инструмент, как Расширенный фильтр. В 2003 этот инструмент можно найти в Данные —Фильтр —Расширенный фильтр. Прелесть этого метода в том, с его помощью можно не портить исходные данные, а создать список в другом диапазоне.
В 2007-2010 Excel, он тоже есть, но немного запрятан. Расположен на вкладке Данные (Data), группа Сортировка и фильтр (Sort & Filter) — Дополнительно (Advanced)
Как его использовать: запускаем указанный инструмент — появляется диалоговое окно:
- Обработка: Выбираем Скопировать результат в другое место (Copy to another location).
- Исходный диапазон (List range): Выбираем диапазон с данными(в нашем случае это А1:А51).
- Диапазон критериев (Criteria range): в данном случае оставляем пустым.
- Поместить результат в диапазон (Copy to): указываем первую ячейку для вывода данных — любую пустую(на картинке — E2).
- Ставим галочку Только уникальные записи (Unique records only).
- Жмем Ок.
Примечание: если вы хотите поместить результат на другой лист, то просто так указать другой лист не получится. Вы сможете указать ячейку на другом листе, но…Увы и ах…Excel выдаст сообщение, что не может скопировать данные на другие листы. Но и это можно обойти, причем довольно просто. Надо всего лишь запустить Расширенный фильтр с того листа, на который хотим поместить результат. А в качестве исходных данных выбираем данные с любого листа — это дозволено.
Так же можно не выносить результат в другие ячейки, а отфильтровать данные на месте. Данные от этого никак не пострадают — это будет обычная фильтрация данных.
Для этого надо просто в пункте Обработка выбрать Фильтровать список на месте (Filter the list, in-place).
Способ 2: Формулы
Этот способ сложнее в понимании для неопытных пользователей, но зато он создает список уникальных значений, не изменяя при этом исходные данные. Ну и он более динамичен: если изменить данные в исходной таблице, то изменится и результат. Иногда это бывает полезно. Попытаюсь объяснить на пальцах что и к чему: допустим, список с данными у Вас расположен в столбце
А
(
А1:А51
, где
А1
— заголовок). Выводить список мы будем в столбец
С
, начиная с ячейки
С2
. Формула в
C2
будет следующая:
{=ИНДЕКС($A$2:$A$51;НАИМЕНЬШИЙ(ЕСЛИ(СЧЁТЕСЛИ($C$1:C1;$A$2:$A$51)=0;СТРОКА($A$1:$A$50));1))}
{=INDEX($A$2:$A$51;SMALL(IF(COUNTIF($C$1:C1;$A$2:$A$51)=0;ROW($A$1:$A$50));1))}
Детальный разбор работы данной формулы приведен в статье: Как просмотреть этапы вычисления формул
Надо отметить, что эта формула является формулой массива. Об этом могут сказать фигурные скобки, в которые заключена данная формула. А вводится такая формула в ячейку сочетанием клавиш —
Ctrl
+
Shift
+
Enter
(при этом сами скобки вводить не надо — они появятся сами после ввода формулы тремя клавишами
Ctrl
+
Shift
+
Enter
). После того, как мы ввели эту формулу в
C2
мы её должны скопировать и вставить в несколько строк так, чтобы точно отобразить все уникальные элементы. Как только формула в нижних ячейках вернет
#ЧИСЛО!(#NUM!)
— это значит все элементы отображены и ниже протягивать формулу нет смысла. Чтобы ошибку избежать и сделать формулу более универсальной(не протягивая каждый раз до появления ошибки) можно использовать нехитрую проверку:
для Excel 2007 и выше:
{=ЕСЛИОШИБКА(ИНДЕКС($A$2:$A$51;НАИМЕНЬШИЙ(ЕСЛИ(СЧЁТЕСЛИ($C$1:C1;$A$2:$A$51)=0;СТРОКА($A$1:$A$50));1));»»)}
{=IFERROR(INDEX($A$2:$A$51;SMALL(IF(COUNTIF($C$1:C1;$A$2:$A$51)=0;ROW($A$1:$A$50));1));»»)}
для Excel 2003:
{=ЕСЛИ(ЕОШ(НАИМЕНЬШИЙ(ЕСЛИ(СЧЁТЕСЛИ($C$1:C1;$A$2:$A$51)=0;СТРОКА($A$1:$A$50));1));»»;ИНДЕКС($A$2:$A$51;НАИМЕНЬШИЙ(ЕСЛИ(СЧЁТЕСЛИ($C$1:C1;$A$2:$A$51)=0;СТРОКА($A$1:$A$50));1)))}
{=IF(ISERR(SMALL(IF(COUNTIF($C$1:C1;$A$2:$A$51)=0;ROW($A$1:$A$50));1));»»;INDEX($A$2:$A$51;SMALL(IF(COUNTIF($C$1:C1;$A$2:$A$51)=0;ROW($A$1:$A$50));1)))}
Тогда вместо ошибки
#ЧИСЛО!(#NUM!)
у вас будут пустые ячейки(не совсем пустые, конечно — с формулами :-)).
Чуть подробнее про отличия и нюансы формул ЕСЛИОШИБКА и ЕСЛИ(ЕОШ можно прочесть в этой статье: Как в ячейке с формулой вместо ошибки показать 0
Для пользователей Excel 2021 выше, а так же пользователей Excel 365(с активной подпиской) — использовать формулы для извлечения уникальных элементов проще простого. В этих версиях появилась функция
УНИК(UNIQUE)
, которая как раз получает список уникальных значений на основании переданного диапазона:
=УНИК($A$2:$A$51)
=UNIQUE($A$2:$A$51)
Что самое важное в данном случае — это функция динамического массива и вводить её надо только в одну ячейку C2, а результат она поместит сама в нужное количество ячеек.
Способ 3: код VBA
Данный подход потребует разрешения макросов и базовых знаний о работе с ними. Если не уверены в своих знаниях для начала рекомендую прочитать эти статьи:
- Что такое макрос и где его искать? к статье приложен видеоурок
- Что такое модуль? Какие бывают модули? потребуется, чтобы понять куда вставлять приведенные ниже коды
Оба приведенных ниже кода следует помещать в стандартный модуль. Макросы должны быть разрешены.
Исходные данные оставим в том же порядке — список с данными расположен в столбце «А«(А1:А51, где А1 — заголовок). Только выводить список мы будем не в столбец С, а в столбец Е, начиная с ячейки Е2:
Sub Extract_Unique() Dim vItem, avArr, li As Long ReDim avArr(1 To Rows.Count, 1 To 1) With New Collection On Error Resume Next For Each vItem In Range("A2", Cells(Rows.Count, 1).End(xlUp)).Value 'Cells(Rows.Count, 1).End(xlUp) – определяет последнюю заполненную ячейку в столбце А .Add vItem, CStr(vItem) If Err = 0 Then li = li + 1: avArr(li, 1) = vItem Else: Err.Clear End If Next End With If li Then [E2].Resize(li).Value = avArr End Sub
С помощью данного кода можно извлечь уникальные не только из одного столбца, но и из любого диапазона столбцов и строк. Если вместо строки
Range(«A2», Cells(Rows.Count, 1).End(xlUp)).Value
указать Selection.Value, то результатом работы кода будет список уникальных элементов из выделенного на активном листе диапазона. Только тогда неплохо бы и ячейку вывода значений изменить — вместо [E2] поставить ту, в которой данных нет.
Так же можно указать конкретный диапазон:
Или другой столбец:
Range("C2", Cells(Rows.Count, 3).End(xlUp)).Value
здесь отдельно стоит обратить внимание то, что в данном случае помимо изменения А2 на С2 изменилась и цифра 1 на 3. Это указание на номер столбца, в котором необходимо определить последнюю заполненную ячейку, чтобы код не просматривал лишние ячейки. Подробнее про это можно прочитать в статье: Как определить последнюю ячейку на листе через VBA?
Универсальный код выбора уникальных значений
Код ниже можно применять для любых диапазонов. Достаточно запустить его, указать диапазон со значениями для отбора только неповторяющихся(допускается выделение более одного столбца) и ячейку для вывода результата. Указанные ячейки будут просмотрены, из них будут отобраны только уникальные значения(пустые ячейки при этом пропускаются) и результирующий список будет записан, начиная с указанной ячейки.
Sub Extract_Unique() Dim x, avArr, li As Long Dim avVals Dim rVals As Range, rResultCell As Range On Error Resume Next 'запрашиваем адрес ячеек для выбора уникальных значений Set rVals = Application.InputBox("Укажите диапазон ячеек для выборки уникальных значений", "Запрос данных", "A2:A51", Type:=8) If rVals Is Nothing Then 'если нажата кнопка Отмена Exit Sub End If 'если указана только одна ячейка - нет смысла выбирать If rVals.Count = 1 Then MsgBox "Для отбора уникальных значений требуется указать более одной ячейки", vbInformation, "www.excel-vba.ru" Exit Sub End If 'отсекаем пустые строки и столбцы вне рабочего диапазона Set rVals = Intersect(rVals, rVals.Parent.UsedRange) 'если указаны только пустые ячейки вне рабочего диапазона If rVals Is Nothing Then MsgBox "Недостаточно данных для выбора значений", vbInformation, "www.excel-vba.ru" Exit Sub End If avVals = rVals.Value 'запрашиваем ячейку для вывода результата Set rResultCell = Application.InputBox("Укажите ячейку для вставки отобранных уникальных значений", "Запрос данных", "E2", Type:=8) If rResultCell Is Nothing Then 'если нажата кнопка Отмена Exit Sub End If 'определяем максимально возможную размерность массива для результата ReDim avArr(1 To Rows.Count, 1 To 1) 'при помощи объекта Коллекции(Collection) 'отбираем только уникальные записи, 'т.к. Коллекции не могут содержать повторяющиеся значения With New Collection On Error Resume Next For Each x In avVals If Len(CStr(x)) Then 'пропускаем пустые ячейки .Add x, CStr(x) 'если добавляемый элемент уже есть в Коллекции - возникнет ошибка 'если же ошибки нет - такое значение еще не внесено, 'добавляем в результирующий массив If Err = 0 Then li = li + 1 avArr(li, 1) = x Else 'обязательно очищаем объект Ошибки Err.Clear End If End If Next End With 'записываем результат на лист, начиная с указанной ячейки If li Then rResultCell.Cells(1, 1).Resize(li).Value = avArr End Sub
Способ 4: Сводные таблицы
Несколько нестандартный способ извлечения уникальных значений.
- Выделяем один или несколько столбцов в таблице, переходим на вкладку Вставка(Insert) -группа Таблица(Table) —Сводная таблица(PivotTable)
- В диалоговом окне Создание сводной таблицы(Create PivotTable) проверяем правильность выделения диапазона данных (или установить новый источник данных)
- указываем место размещения Сводной таблицы:
- На новый лист (New Worksheet)
- На существующий лист (Existing Worksheet)
- подтверждаем создание нажатием кнопки OK
Т.к. сводные таблицы при обработке данных, которые помещаются в область строк или столбцов, отбирают из них только уникальные значения для последующего анализа, то от нас ровным счетом ничего не требуется, кроме как создать сводную таблицу и поместить в область строк или столбцов данные нужного столбца.
На примере приложенного к статье файла я:
- выделил диапазон A1:B51 на листе Извлечение по критерию
- вызвал меню вставки сводной таблицы: вкладка Вставка(Insert) -группа Таблица(Table) —Сводная таблица(PivotTable)
выбрал вставить на новый лист(New Worksheet) - назвал этот лист Уникальные сводной таблицей
- поле Данные поместил в область строк
- поле ФИО в область фильтра. Почему? Чтобы удобно было выбирать одно или несколько ФИО и в сводной отображался бы список уникальных месяцев только для выбранных фамилий
В чем неудобство работы со сводными в данном случае: при изменении в исходных данных сводную таблицу придется обновлять вручную: Выделить любую ячейку сводной таблицы -Правая кнопка мыши —Обновить(Refresh) или вкладка Данные(Data) —Обновить все(Refresh all) —Обновить(Refresh). А если исходные данные пополняются динамически и того хуже — надо будет заново указывать диапазон исходных данных. И еще один минус — данные внутри сводной таблицы нельзя менять. Поэтому если с полученным списком необходимо будет работать в дальнейшем, то после создания нужного списка при помощи сводной его надо скопировать и вставить на нужный лист.
Чтобы лучше понимать все действия и научиться обращаться со сводными таблицами настоятельно рекомендую ознакомиться со статьей Общие сведения о сводных таблицах — к ней приложен видеоурок, в котором я наглядно демонстрирую простоту и удобство работы с основными возможностями сводных таблиц.
В приложенном примере помимо описанных приемов, записана чуть более сложная вариация извлечения уникальных элементов формулой и кодом, а именно: извлечение уникальных элементов по критерию. О чем речь: если в одном столбце фамилии, а во втором(В) некие данные(в файле это месяцы) и требуется извлечь уникальные значения столбца В только для выбранной фамилии. Примеры подобных извлечений уникальных расположены на листе Извлечение по критерию.
Скачать пример:
Tips_All_ExtractUnique.xls (108,0 KiB, 18 432 скачиваний)
Также см.:
Работа с дубликатами
Как подсчитать количество повторений
Общие сведения о сводных таблицах
Статья помогла? Поделись ссылкой с друзьями!
Видеоуроки
Поиск по меткам
Access
apple watch
Multex
Power Query и Power BI
VBA управление кодами
Бесплатные надстройки
Дата и время
Записки
ИП
Надстройки
Печать
Политика Конфиденциальности
Почта
Программы
Работа с приложениями
Разработка приложений
Росстат
Тренинги и вебинары
Финансовые
Форматирование
Функции Excel
акции MulTEx
ссылки
статистика
Отбор уникальных значений из списка в VBA Excel с помощью объекта Collection. Выгрузка уникальных элементов в ListBox и ячейки рабочего листа. Скачать файл с примером кода.
Отбор уникальных значений из списка
При написании макросов для работы с данными в VBA Excel иногда возникает необходимость отбора уникальных значений из списка с повторяющимися элементами. Для этого можно воспользоваться следующим кодом:
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 |
Sub ОтборУникальных() ‘Объявляем переменные ‘myRange — диапазон ячеек, заполненный исходным списком элементов ‘myCell — отдельная ячейка диапазона ‘myCollection — коллекция ‘myElement — элемент коллекции (должен быть типа «Variant») Dim myRange As Range, myCell As Range, myCollection As New Collection, _ myElement As Variant, i As Long ‘присваиваем переменной myRange диапазон ячеек с исходным списком элементов Set myRange = Range(«A1:A20») ‘заполняем новую коллекцию уникальными элементами On Error Resume Next For Each myCell In myRange myCollection.Add CStr(myCell.Value), CStr(myCell.Value) Next myCell On Error GoTo 0 |
На этом отбор уникальных значений завершен. Коллекция заполнена уникальными элементами.
Добавление уникальных элементов в ListBox
Теперь можно добавить уникальные значения в ListBox, если перед этим создать форму UserForm1 и на нее добавить элемент управления ListBox1:
For Each myElement In myCollection UserForm1.ListBox1.AddItem myElement Next myElement |
ListBox заполнен уникальными значениями из коллекции. Другие способы заполнения ListBox и ComboBox смотрите здесь.
Запись уникальных значений на рабочий лист
А так можно добавить уникальные элементы в ячейки столбца «В» активного рабочего листа:
For Each myElement In myCollection i = i + 1 Cells(i, 2) = myElement Next myElement |
При необходимости сортируем полученный список в столбце «В»:
Range(Cells(1, 2), Cells(i, 2)).Sort Key1:=Range(«B1»), Order1:=xlAscending, _ Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom |
А также можно отобразить количество найденных уникальных элементов, если, конечно, на форму UserForm1 добавлен элемент управления Label1:
UserForm1.Label1.Caption = «Уникальных элементов: « & myCollection.Count ‘отображаем форму UserForm1.Show End Sub |
Если вам необходимо в ListBox или ComboBox загрузить отсортированный список, его элементы можно добавить с листа Excel после сортировки, в данном примере из диапазона Range(Cells(1, 2), Cells(i, 2)).
Обратите внимание, что в представленном коде VBA Excel для отбора уникальных значений из списка, выгрузки их в ListBox и записи на рабочий лист идет сплошная нумерация от Sub ОтборУникальных() и до End Sub.
Для наглядного ознакомления с работой представленного кода вы можете скачать демонстрационный файл.
Смотрите, как удалить повторяющиеся значения из диапазона ячеек в VBA Excel с помощью метода Range.RemoveDuplicates и отобрать уникальные значения из списка с помощью объекта Dictionary.
Функция 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:
http://excelvba.ru/code/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
- 41361 просмотр
Не получается применить макрос? Не удаётся изменить код под свои нужды?
Оформите заказ у нас на сайте, не забыв прикрепить примеры файлов, и описать, что и как должно работать.