Отбор уникальных значений из списка в 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.
Хитрости »
1 Май 2011 532206 просмотров
Как получить список уникальных(не повторяющихся) значений?
Представим себе большой список различных наименований, ФИО, табельных номеров и т.п. А необходимо из этого списка оставить список все тех же наименований, но чтобы они не повторялись — т.е. удалить из этого списка все дублирующие записи. Как это иначе называют: создать список уникальных элементов, список неповторяющихся, без дубликатов. Для этого существует несколько способов: встроенными средствами 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 433 скачиваний)
Также см.:
Работа с дубликатами
Как подсчитать количество повторений
Общие сведения о сводных таблицах
Статья помогла? Поделись ссылкой с друзьями!
Видеоуроки
Поиск по меткам
Access
apple watch
Multex
Power Query и Power BI
VBA управление кодами
Бесплатные надстройки
Дата и время
Записки
ИП
Надстройки
Печать
Политика Конфиденциальности
Почта
Программы
Работа с приложениями
Разработка приложений
Росстат
Тренинги и вебинары
Финансовые
Форматирование
Функции Excel
акции MulTEx
ссылки
статистика
I would use a simple VBA-Collection
and add items with key. The key would be the item itself and because there can’t be duplicit keys the collection will contain unique values.
Note: Because adding duplicit key to collection raises error wrap the call to collection-add into a on-error-resume-next.
The function GetUniqueValues
has source-range-values as parameter and retuns VBA-Collection
of unique source-range-values. In the main
method the function is called and the result is printed into Output-Window. HTH.
Sample source range looked like this:
Option Explicit
Sub main()
Dim uniques As Collection
Dim source As Range
Set source = ActiveSheet.Range("A2:F6")
Set uniques = GetUniqueValues(source.Value)
Dim it
For Each it In uniques
Debug.Print it
Next
End Sub
Public Function GetUniqueValues(ByVal values As Variant) As Collection
Dim result As Collection
Dim cellValue As Variant
Dim cellValueTrimmed As String
Set result = New Collection
Set GetUniqueValues = result
On Error Resume Next
For Each cellValue In values
cellValueTrimmed = Trim(cellValue)
If cellValueTrimmed = "" Then GoTo NextValue
result.Add cellValueTrimmed, cellValueTrimmed
NextValue:
Next cellValue
On Error GoTo 0
End Function
Output
SGD
PHP
KRW
CNY
IDA
BGN
PDSS
CBBT
INPC
DBS
a
In case when the source range consists of areas get the values of all the areas first.
Public Function GetSourceValues(ByVal sourceRange As Range) As Collection
Dim vals As VBA.Collection
Dim area As Range
Dim val As Variant
Set vals = New VBA.Collection
For Each area In sourceRange.Areas
For Each val In area.Value
If val <> "" Then _
vals.Add val
Next val
Next area
Set GetSourceValues = vals
End Function
Source type is now Collection but then all works the same:
Dim uniques As Collection
Dim source As Collection
Set source = GetSourceValues(ActiveSheet.Range("A2:F6").SpecialCells(xlCellTypeVisible))
Set uniques = GetUniqueValues(source)
Функция 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
Кто-нибудь может подсказать хотя бы примерный код, делающий следующее: |
|
yozhik Пользователь Сообщений: 957 |
а записать макрорекодером? и вставить вначале кода i=val(inputbox(«введите номер столбца»)) |
Именно макрорекодером я и записал этот элементарный код. А каким кодом можно вставить ИМЕННО УНИКАЛЬНЫЕ ЗАПИСИ? Чтобы при вставке не повторялись вставляемые записи. |
|
yozhik Пользователь Сообщений: 957 |
sub тест Columns(i).Select end sub глобально не тестировал, но вроде работает, создает список уникальных значений во втором столбце с ячейки В1 |
yozhik Пользователь Сообщений: 957 |
а э-э… сорри, невнимательно читал, с другим листом такой вариант не катит |
Уважаемый yozhik, к сожалению, у меня не работает этот код. То есть он вставляет ВСЕ записи, с повторениями. Но спасибо за подсказку. Ща буду разбираться. То есть каждый столбец у меня имеет заголовок. Можно как-то сделать так, чтобы мне предлагался список заголовков и я бы мог выбирать нужный столбец с помощью заголовка? Спасибо |
|
Вроде разобралися и все работает. Спасибо yozhik за подсказку. Только вот пока не знаю, как выбор столбца осуществить с помощью выбора заголовка столбца. Может кто подскажет? Спасибо. |
|
yozhik Пользователь Сообщений: 957 |
выбор заголовка можно организовать в ячейке с помощью выпадающего списка через data-validation-выбрать list-задать диапазон. в коде прописать переменную, которой присваивать выбираемое значение, далее прописать поиск значения переменной в строке заголовка и другой переменной присвоить номер столбца. а дальше тож самое. Прошу прощения, сам с ходу не напишу, но все можно частями найти на сайте и собрать в кучу. код небольшой выйдет. так же можно сделать выбор заголовка через Dialog — навести мышь на заголовок листа, правая кнопка — insert-MS Excel 5.0 Dialog, а потом в коде вызвать это окно. проще, чем свою форму создавать. |
N1K0 Пользователь Сообщений: 70 |
{quote}{login=yozhik}{date=12.08.2008 10:53}{thema=}{post}sub тест Columns(i).Select end sub {/post}{/quote} |
Hugo Пользователь Сообщений: 23253 |
Вот, выберите, что надо: Function NoDups(Rng As Range, Optional Mask = «*») |
Hugo Пользователь Сообщений: 23253 |
Хотя можно брать целиком. Sub test() Только сортировка неидеальная: |
N1K0 Пользователь Сообщений: 70 |
{quote}{login=Hugo}{date=11.04.2010 09:44}{thema=}{post}Хотя можно брать целиком. Sub test() |
Hugo Пользователь Сообщений: 23253 |
Ну да, под задачу можно так: Sub copyuniq() Ну а если надо эти уникальные в коде по-одному использовать, тогда в массив и его вертеть… |
N1K0 Пользователь Сообщений: 70 |
спасибо. пригодились оба метода |
{quote}{login=Hugo}{date=11.04.2010 10:25}{thema=}{post}Ну да, под задачу можно так: Sub copyuniq() Ну а если надо эти уникальные в коде по-одному использовать, тогда в массив и его вертеть…{/post}{/quote} |
|
эта функция ведь может выбирать диапазон не только одномерный, |
|
Hugo Пользователь Сообщений: 23253 |
Но ведь можно параллельно с занесением в коллекцию или словарь (кстати, тогда можно уникальные не по одному полю брать, а например по A&C&E) сразу же набивать итоговый массив из нужных полей. |
Юрий М Модератор Сообщений: 60585 Контакты см. в профиле |
{quote}{login=Hugo}{date=27.09.2010 10:07}{thema=}{post}Вот только сортировку продумать… можно позже отсортировать.{/post}{/quote} <BR>Hugo, вот здесь ZVI про сортировку: http://www.planetaexcel.ru/forum.php?thread_id=7702 |
{quote}{login=Hugo}{date=27.09.2010 10:07}{thema=}{post}Но ведь можно параллельно с занесением в коллекцию или словарь (кстати, тогда можно уникальные не по одному полю брать, а например по A&C&E) сразу же набивать итоговый массив из нужных полей. |
|
вот что то подобное только ьез промежуточной выгрузки на лист |
|
{quote}{login=n1}{date=27.09.2010 11:56}{thema=}{post}вот что то подобное только ьез промежуточной выгрузки на лист{/post}{/quote} |
|
Hugo Пользователь Сообщений: 23253 |
Вот переделал другой код. Результат идентичен. Sub SvodByHugo() Set oDict1 = CreateObject(«Scripting.Dictionary») With ThisWorkbook.Worksheets(1) End Sub |
Hugo Пользователь Сообщений: 23253 |
В смысле идентичен результату расширенного фильтра, и это всё ответ n1 |
{quote}{login=Hugo}{date=28.09.2010 09:40}{thema=}{post}В смысле идентичен результату расширенного фильтра, и это всё ответ n1 :){/post}{/quote} фильтр работает при этом объеме данных(65536 стр) примерно в два раза быстрее(визуально), но и ваш макрос шустрый однако |
|
n1 |
|
Hugo Пользователь Сообщений: 23253 |
Это я знаю. Но на практике не часто бывает 65536 записей… |
Это ошибка приопределения нижней границы данных используемым способом |
|
Hugo Пользователь Сообщений: 23253 |
#30 28.09.2010 12:43:07 И если есть такая возможность, то можно проверить Rows.Count ячейку в этом анализируемом столбце, и если там есть значение, то это число (Rows.Count) и будет lr. |