Форум программистов, компьютерный форум CyberForum.ru

VBA

Войти
Регистрация
Восстановить пароль
 
Рейтинг: Рейтинг темы: голосов - 68, средняя оценка - 4.65
Savelev
Сообщений: n/a
#1

Как получить уникальные значения из колонки VBA Excel? - VBA

10.09.2008, 15:54. Просмотров 9093. Ответов 7
Метки нет (Все метки)

Как получить уникальные значения из колонки таблицы в VBA Excel например в массив?

При работе в Excel при установке автофильтра, Excel моментом заполняет ListBox уникальными значениями, даже при большом заполнении таблицы.
Similar
Эксперт
41792 / 34177 / 6122
Регистрация: 12.04.2006
Сообщений: 57,940
10.09.2008, 15:54
Здравствуйте! Я подобрал для вас темы с ответами на вопрос Как получить уникальные значения из колонки VBA Excel? (VBA):

VBA Excel listbox уникальные значения - VBA
Допустим у меня есть listbox1 12 32 32 12 12 4 6

VBA Excel Номер ваделенной колонки, получение номера выделенной колонки - VBA
Как получить номер выделенной колонки, т.е. выделил колону 'С', а он мне выдал, колонка '3', а не 'C:C' Заранее спасибо

Как получить строку гиперссылки в VBA Excel - VBA
В ячейке “A2” Exel таблицы, находится рабочая гиперссылка, которая хорошо видна, если к ней подвести мышку. В VBA оператор str =...

Как получить отфильтрованный список в Excel VBA? - VBA
Подскажите, пожалуйста, если в результате применения фильтра на странице в Excel скрывается часть строк, как узнать какие строки остались...

Заполнение первой колонки простыми числами до тысячи VBA Excel - VBA
Здравствуйте, подскажите пожалуйста как написать программу на VBA в Excel, чтобы ячейки первого колонки заполнялись простыми числами до...

Как с помощью VBA в Excel можно получить координаты определенной ячейки? - VBA
Как с помощью VBA в екселе можно получить координаты определенной ячейки. Просто в определенную ячейку надо вставить имейдж

Надоела реклама? Зарегистрируйтесь и она исчезнет полностью.
Korolana
0 / 0 / 0
Регистрация: 27.08.2008
Сообщений: 154
11.09.2008, 22:07 #2
Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
Sub FillArrayWithUniqueValue()
Dim MyArray() As Variant
 
    Columns('A:A').Select  ' select your column
    Range('A1:A14').AdvancedFilter Action:=xlFilterInPlace, Unique:=True   ' filter on this column to receive unique values
               ' part of rows will be hidden and I need not include them into my next selection
 
    ActiveCell.CurrentRegion.Select ' copy unique values from this column to some free temporary place and select this region
    nRow = Selection.Rows.Count
    Selection.Copy
    ActiveSheet.Paste Destination:=Cells(nRow + 2, 2)
    Cells(nRow + 2, 2).Select
    ActiveCell.CurrentRegion.Select
   
 
    MyArray = Selection  'fill my array with our unique values from Excel
    ActiveCell.CurrentRegion.Clear  ' clear our temporary region
    ActiveSheet.ShowAllData         ' clear our filter
    
   
End Sub
Now, all your data in two-dimensial array.
In this case, you can see your data it in Myarray(1,1), MyArray(2,1)...and so on
Savelev
Сообщений: n/a
15.09.2008, 11:54 #3
Спасибо за пример.
yuniki
0 / 0 / 0
Регистрация: 28.09.2007
Сообщений: 285
18.09.2008, 12:10 #4
Я это делаю по другому (нужно для заполнения списков в контролах):

' Выбирает из заданого именованного диапазона с заголовком RngName
' столбик fldName и отбирает только уникальные его значения
' в массиве aSel (<размер массива>,<Значение1>,...)
' Структура именованного диапазона :
' <ИмяСтолбца1 ><ИмяСтолбца2>...
' <ЗначСтолбца1><ЗначCтолбца2>...

Public Function UnicSelect(ByRef rngName As String, ByRef fldName As String, _
ByRef aSel() As Variant, _
Optional ByRef strSQL As String = '')
Dim cnn As ADODB.Connection, Rs As ADODB.Recordset, i As Long
Set cnn = New ADODB.Connection
cnn.Open 'Provider=Microsoft.Jet.OLEDB.4.0;' & _
'Data Source=' & _
ActiveWorkbook.Path + ' ' + ActiveWorkbook.Name & ';' & _
'Extended Properties=Excel 8.0' 'HDR=Yes;'
Set Rs = New ADODB.Recordset
Rs.Open Source:='SELECT distinct ' & fldName & ' from ' & rngName, _
ActiveConnection:=cnn, _
CursorType:=adOpenDynamic, _
LockType:=adLockReadOnly, _
Options:=adCmdText
ReDim Preserve aSel(0) ' инициализация массива
aSel(0) = 0 ' 0-й элемент хранит размер массива
i = 0
Rs.MoveFirst
Do While Not Rs.EOF
ReDim Preserve aSel(i + 1)
aSel(UBound(aSel)) = Rs.Fields(fldName)
Rs.MoveNext: i = i + 1
Loop
aSel(0) = UBound(aSel) '
Rs.Close: cnn.Close: Set Rs = Nothing: Set cnn = Nothing
End Function ' UnicSelect -->>
Korolana
0 / 0 / 0
Регистрация: 27.08.2008
Сообщений: 154
18.09.2008, 21:28 #5
This way is right too, but much slower. Try it.
maks_well
0 / 0 / 0
Регистрация: 29.06.2008
Сообщений: 5
25.09.2008, 15:04 #6
Попробуй на скорость это
По-моему алгоритм уже был когда-то на этом форуме

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
Sub FormSpisok(ListName, FirstRow, NumColumn, Spisok)
 
'Формирует (в массив Spisok) список строк неповторяющихся значений из листа ListName в столбце NumColumn, начиная с ряда FirstRow
'Ограничение на листе-первое пустое значение
'Первое значение массива Spisok(0)-кол-во значений
 
Dim numb As Integer
Dim stroka As String
Dim DataValues As New Collection
 
ReDim Spisok(1)
Spisok(0) = 0
 
stroka = Trim(Sheets(ListName).Cells(FirstRow, NumColumn))
On Error Resume Next
Do While stroka <> ''
   DataValues.Add stroka, stroka
   FirstRow = FirstRow + 1
   stroka = Trim(Sheets(ListName).Cells(FirstRow, NumColumn))
   Loop
On Error GoTo 0
 
numb = 1
For Each DataValue In DataValues
   ReDim Preserve Spisok(numb + 1)
   Spisok(numb) = DataValue
   numb = numb + 1
Next
Spisok(0) = numb - 1
End Sub
Serg_FSM
0 / 0 / 0
Регистрация: 23.07.2008
Сообщений: 47
25.09.2008, 17:02 #7
Приветствую.
Несколько измененый вариант, предложенный Короланой, извлекает уникальные значения из столбца с активной ячейкой:
Visual Basic
1
2
3
4
5
Public Sub FillArrayWithUniqueValue()
Dim MyArray() As Variant
ActiveCell.EntireColumn.AdvancedFilter Action:=xlFilterCopy, copytorange:=Cells(2, 4), unique:=True 'filter for current column
MyArray = Cells(2, 4).CurrentRegion.Value
Cells(2, 4).CurrentRegion.Clear ' clear our temporary region
правда не работает если первая ячейка пустая и еще можно потерять часть значений (из-за использования CurrentRegion) если среди уникальных есть пустая ячейка (хотя если перед заполнением массива отсортировать temporary region, то может получиться)
wanton2
0 / 0 / 0
Регистрация: 25.01.2009
Сообщений: 14
17.06.2009, 16:06 #8
как уникальные найти я понял...
а как отметить строки *дубликатов* каким - ниб. цветом???
можно найти unique-> Selection.покрасить-> ShowAllData-> если не закрашено, то закрасить своим цветом....
но если 4 дубликата, то незакр. будет 3!!!
как сделать 'красиво'?

что то я туплю мало-мало... ;-/

гуру, подскажите, плз!

заранее, 10х!
MoreAnswers
Эксперт
37091 / 29110 / 5898
Регистрация: 17.06.2006
Сообщений: 43,301
17.06.2009, 16:06
Привет! Вот еще темы с ответами:

Уникальные значения столбца А по сравнению со столбцом С и уникальные значения в столбце С по сравнению с А? - VBA
Ребята всем привет, как реализовать макросом? Есть два столбца А и С в каждом списки наименований.Как вывести в столбцы F и H(либо на...

не знаю как из VBA собрать какие-либо уникальные данные о компьютере - VBA
Создал прайс и разбросал по точкам, по нажатию Command button хочу чтобы макрос дописывал в конце листа номер телефона торговой точки, а...

Как из VBA получить доступ к "умным таблицам" Excel? - VBA
Добрый день. Буду очень признателен, если кто-нибудь подскажет, как можно из VBA получить перечень всех &quot;умных таблиц&quot; в Excel 2010? Я до...

Excel VBA. Не присваиваются значения массиву - VBA
Доброго времени суток всем! Коротко о главном: В Функции, располагающейся в ЭтаКнига необходимо присвоить данные массиву. Само...


Искать еще темы с ответами

Или воспользуйтесь поиском по форуму:
Yandex
Объявления
17.06.2009, 16:06
Ответ Создать тему
Опции темы

КиберФорум - форум программистов, компьютерный форум, программирование
Powered by vBulletin® Version 3.8.9
Copyright ©2000 - 2017, vBulletin Solutions, Inc.
Рейтинг@Mail.ru