Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
Сбор уникальных данных из строки данных VBA (не сводная), Сбор уникальных данных из строки методами, отличными от сводной таблицы
 
#1
27.04.2018 10:08:08
Коллеги, добрый день.

Предположим я хочу узнать какие фрукты есть во всём мире.
Собрал массив данных, в котором очень много повторяющихся данных.

Подскажите пожалуйста как из этой строки собрать уникальные значения средствами VBA, без использования сводных таблиц.  
 
 
 
#2
27.04.2018 10:09:50
словарем проще всего, если "удалить дубликаты" не подходит
http://perfect-excel.ru/publ/excel/makrosy_i_programmy_vba/ischerpyvajushhee_opis­anie_obekta_diction...
 
 
 
#3
27.04.2018 10:20:46
Привет!
Цитата
Kolesnikov написал:
из этой строки
Пожалуйста, покажите Вашу "строку"
Сравнение прайсов, таблиц - без настроек
 
 
 
#4
27.04.2018 10:23:43
Kolesnikov, здравствуйте!
Цитата
Inexsu написал:
покажите Вашу "строку"
подозреваю, что имеется ввиду столбец с повторяющимися ячейками  :D без файла-примера гадать неохота
Изменено: Jack Famous - 27.04.2018 10:24:02
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
 
 
 
#5
27.04.2018 10:36:55
Kolesnikov, изучайте: https://www.google.ru/search?q=удаление+дубликатов+site%3Aplanetaexcel.ru
 
 
 
#6
27.04.2018 11:19:51
Цитата
Jack Famous написал:
подозреваю, что имеется ввиду столбец с повторяющимися ячейками
Да, коллеги, прошу прощения - забыл приложить файл - пример.  
 
 
 
#7
27.04.2018 11:41:55
Код
Sub Макрос1()
  [a1].CurrentRegion.AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("C1"), Unique:=True
End Sub
Сравнение прайсов, таблиц - без настроек
 
 
 
#8
27.04.2018 11:50:31
Inexsu, быстро и изящно  :idea:
маленький OFF: подскажите пожалуйста, а как без вставки на лист забрать уникальные в массив этим методом?
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
 
 
 
#9
27.04.2018 16:54:53
Inexsu, действительно волшебство...  
 
 
 
#10
27.04.2018 17:01:14
Kolesnikov,
Макрос (автора не помню, изменил для себя) для выделенного диапазона
Изменено: Jack Famous - 27.04.2018 17:05:43
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
 
 
 
#11
27.04.2018 17:30:33
Jack Famous, сложновато ж как-то...для уникальных словарь наверное проще использовать, и код короче..
Код
Sub PUniq()
Dim dicUn, v
Set dicUn = CreateObject("Scripting.Dictionary")
For Each cl In Selection
    v = dicUn.Item(cl.Value)
Next
Range(Selection.Address).ClearContents
Selection.Cells(1).Resize(dicUn.Count, 1).Value = Application.Transpose(dicUn.keys)
End Sub
 
 
 
#12
27.04.2018 17:43:10
yozhik, в случае, когда нужно просто собрать - да. Однако лично я этот код использую, чтобы в "умных" таблицах строки-дубли удалять по столбцу, да и не мой он, повторюсь — адаптировал под себя больше года назад, когда вообще почти ничего не умел (от слова совсем)  :D
Для этого Словари и Коллекции, конечно, тоже помогут (проверять наличие в словаре и удалять строку через обратный цикл), но мне пока этого хватает  ;)
Изменено: Jack Famous - 27.04.2018 18:19:09
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
 
 
 
#13
28.04.2018 01:45:05
Цитата
Jack Famous написал:
забрать уникальные в массив этим методом
Пока не знаю.
Где-то видел,  Юрий М писал, что он читал, как это умеет Уокенбах  8)  
Сравнение прайсов, таблиц - без настроек
 
 
 
#14
28.04.2018 09:15:49
Не помню такого :)
 
 
 
#15
28.04.2018 10:26:54
Цитата
Inexsu написал:
это умеет Уокенбах
ссылочку бы  :D

UPD: честно искал по запросу from Advanced Filter to Array John Walkenbach, но ничего  :(
Изменено: Jack Famous - 28.04.2018 11:12:45
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
 
 
 
#16
28.04.2018 10:56:17
Уокенбах, конечно, авторитет, но не
Цитата
Jack Famous написал:
Massiv

8)  
Сравнение прайсов, таблиц - без настроек
 
 
 
#17
28.04.2018 11:05:48
Цитата
Юрий М написал:
Не помню
а интернет помнит
Сравнение прайсов, таблиц - без настроек
 
 
 
#18
28.04.2018 11:11:31
Цитата
Inexsu написал: а интернет помнит
А примера от Уокенбаха и ссылки на него и там нет...
Согласие есть продукт при полном непротивлении сторон
 
 
 
#19
28.04.2018 11:12:17
Inexsu, тупанул малях  :D
нашёл только отдельно работу с расширенным фильтром и отдельно приёмы извлечения уникальных (как вот тут)
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
 
 
 
#20
28.04.2018 11:14:57
Inexsu, согласен с Sanja  :(
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
 
 
 
#21
28.04.2018 11:25:20
Цитата
Sanja написал:
примера от Уокенбаха и ссылки на него и там нет.
Бороться и искать, найти и перепрятать.
Сайт Пирсона пропал  :(  
Изменено: Inexsu - 28.04.2018 11:26:03
Сравнение прайсов, таблиц - без настроек
 
 
 
#22
28.04.2018 11:27:11
Inexsu, может и тут РКН посодействовал?  :D
а как найти теперь? по каким тэгам?
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
 
 
 
#23
28.04.2018 11:35:48
Inexsu, так ведь там разговор про уникальные с листа (после фильтра). А Джек, если я правильно понял, хотел бы без обращения к ячейкам листа )
 
 
 
#24
28.04.2018 11:36:35
Цитата
Jack Famous написал:
как найти
Говорят, в интернетах есть архив
Сравнение прайсов, таблиц - без настроек
 
 
 
#25
28.04.2018 11:43:53
Цитата
Юрий М написал:
там разговор про уникальные с листа (после фильтра)
ТС там писал:
1. отфильтровать уникальные  
2. скопировать уникальные  
3. вставить уникальные куда-то  
4. из этого откуда то - записать в массив  
 
неужто нельзя  
1. отфильтровать уникальные    
2. занести в массив
---
Прям взаимоконгруэнтно с Jack Famous,
Сравнение прайсов, таблиц - без настроек
 
 
 
#26
28.04.2018 11:47:39
Цитата
Inexsu написал:
отфильтровать уникальные … занести в массив
именно!  :D на ум приходит только цикл по видимым, но это не круто — тогда уж проще забрать ВСЁ в массив и прогнать через словарь (или сразу в словарь заносить). Пошустрее должно быть…
Ну или (как вы уже сказали) скопировать уникальные на временный лист и забрать оттуда — даст выигрыш на огромных объёмах
Цитата
Inexsu написал:
архив
ЧТО ЭТО и с чем его есть???  8-0
Изменено: Jack Famous - 28.04.2018 11:52:11
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
 
 
 
#27
28.04.2018 18:36:22
Через SQL
Код
Public Sub RefreshData()
'Created using add-in ActiveTables
Dim strConnection As String
Dim strSQL As String
strConnection = IIf(Val(Application.Version) < 12, "OLEDB;Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & ThisWorkbook.FullName & ";Extended Properties='Excel 8.0;HDR=YES;IMEX=3';", "OLEDB;Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ThisWorkbook.FullName & ";Extended Properties='Excel 12.0;HDR=YES;IMEX=3';")
strSQL = "SELECT DISTINCT   Фрукт  FROM   [Лист1$]"
With ThisWorkbook.ActiveSheet
    With .QueryTables.Add(strConnection, .Range("b1"), strSQL)
         .Refresh False
         .Delete
    End With
End With
End Sub
Excel + SQL = Activetables
 
 
 
Страницы: 1
Наверх