Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1 2 След.
RSS
Наиболее быстрое сравнение двух огромных списков
 
#1
31.01.2019 16:31:17
Добрый день!
А вот такая задача пришла:
Необходимо на регулярной основе сравнивать два списка номенклатур. Они огромные - 810 870 строк один и 815 432 строк второй (в следующем месяце будет примерно также). Различаются они, как показала практика (см. ниже), на 5 149 номенклатур. Списки состоят из уникальных номеров номенклатур каждый и в большинстве номенклатур оба списка пересекаются. Необходимо выявить различие.

Первое что я попробовал - ВПР. С 0% до 1% переключилось примерно через 4-5 минут, а запускать его надо дважды - для каждого списка.

Второе - ИНДЕКС-ПОИСКПОЗ. Здесь я сам выключил примерно через 20 минут, т.к. не понимал, сколько прошло/осталось, потому что не было процентной индикации вообще.

Дальше я просмотрел несколько форумов, но на них было написано, что не стоит менять формулу на пользовательскую функцию (аналог ВПР), т.к. быстрее работать не будет.

Самое быстрое решение, которое я нашел:
- загрузить оба списка в одну таблицу Access
- с помощью запроса выявить уникальные номенклатуры (повторяются не больше 1 раза) и экспортировать их в Excel
- с помощью Excel и ВПР создать небольшую таблицу, где будет показано какие номенклатуры где отсутствуют (см. "Результат после Access")
На все вместе ушло примерно 20 минут.

Есть ли способ сделать то же самое, но быстрее, без Access и в Excel? :)
 
 
 
#2
31.01.2019 16:33:25
Макросом.
Код
Sub BigLists()
Dim arr1(), arr2(), I&
Dim dic As Object
arr1 = Range("A2:A" & Cells(Rows.Count, 1).End(xlUp).Row).Value
arr2 = Range("D2:D" & Cells(Rows.Count, 4).End(xlUp).Row).Value
ReDim Preserve arr2(1 To UBound(arr2), 1 To 2)
Set dic = CreateObject("Scripting.Dictionary")
On Error Resume Next
'Заносим в словарь БОЛЬШИЙ список
For I = 1 To UBound(arr1):
    dic.Add (arr1(I, 1)), "Нет в списке2"
Next
For I = 1 To UBound(arr2)
    If dic.Exists(arr2(I, 1)) Then
        dic(arr2(I, 1)) = "Есть в списке2"
        arr2(I, 2) = "Есть в списке1"
    Else
        arr2(I, 2) = "Нет в списке1"
    End If
Next
Range("G2").Resize(dic.Count, 2) = Application.Transpose(Array(dic.Keys, dic.Items))
Range("J2").Resize(UBound(arr2), 2) = arr2
End Sub
Изменено: Sanja - 31.01.2019 16:53:55
Согласие есть продукт при полном непротивлении сторон
 
 
 
#3
31.01.2019 16:56:45
Доброе время суток.
На Power Query. Тестировал по миллиону строк в каждой таблице с разницей в 5000 значений в каждой - 20 секунд.
 
 
 
#4
31.01.2019 17:21:06
Sanja,  а где проверка значений первого массива, которых нет во втором? Или я туплю на ровном месте?
 
 
 
#5
01.02.2019 08:37:10
Sanja, Макрос отработал быстро (всего несколько минут), но почему-то результатом его действий стало копирование Списка2 с пометкой, что номенклатур нет в Списке1.

Андрей VG, PowerQuery, к сожалению, наши IT ставить не хотят (у нас MS Office 2010) =/ Но спасибо за подсказку)
Изменено: Awallon - 01.02.2019 08:38:37
 
 
 
#6
01.02.2019 09:19:02
Sanja, Microsoft не гарантирует в словаре соответствие позиций ключей и значений, т.е. так выгружать опасно!
 
 
 
#7
01.02.2019 09:21:42
Цитата
Awallon написал:
к сожалению, наши IT ставить не хотят
А вы составили убедительное экономическое обоснование?
Версия на SQL. Файл сохранить в папку c:\Path. ПКМ на таблице листа Результат - обновить.
 
 
 
#8
01.02.2019 09:22:02
Цитата
Awallon написал: но почему-то...
Я ориентировался на массивы из Вашего примера. Для наглядности совпадения результатов с Вашими, изменил вывод результатов со слов на 1/0, и вставил формулы проверки. Также немного увеличил первый список
Код
Sub BigLists()
Dim arr1(), arr2(), I&
Dim dic As Object
arr1 = Range("A2:A" & Cells(Rows.Count, 1).End(xlUp).Row).Value
arr2 = Range("D2:D" & Cells(Rows.Count, 4).End(xlUp).Row).Value
ReDim Preserve arr2(1 To UBound(arr2), 1 To 2)
Set dic = CreateObject("Scripting.Dictionary")
On Error Resume Next
'Заносим в словарь БОЛЬШИЙ список
For I = 1 To UBound(arr1):
    dic.Add (arr1(I, 1)), 1 '"Нет в списке2"
Next
For I = 1 To UBound(arr2)
    If dic.Exists(arr2(I, 1)) Then
        dic(arr2(I, 1)) = 0 '"Есть в списке2"
        arr2(I, 2) = 0 '"Есть в списке1"
    Else
        arr2(I, 2) = 1 '"Нет в списке1"
    End If
Next
Range("G2").Resize(dic.Count, 2) = Application.Transpose(Array(dic.Keys, dic.Items))
Range("L2").Resize(UBound(arr2), 2) = arr2
End Sub
Согласие есть продукт при полном непротивлении сторон
 
 
 
#9
01.02.2019 09:23:02
Hugo, да, сам когда-то об этом писал :) , но не разу не сталкивался.
С учетом вышеуказанного
Код
Sub BigLists()
Dim arr1(), arr2(), I&
Dim dic As Object
arr1 = Range("A2:A" & Cells(Rows.Count, 1).End(xlUp).Row).Value
arr2 = Range("D2:D" & Cells(Rows.Count, 4).End(xlUp).Row).Value
ReDim Preserve arr2(1 To UBound(arr2), 1 To 2)
Set dic = CreateObject("Scripting.Dictionary")
On Error Resume Next
'Заносим в словарь БОЛЬШИЙ список
For I = 1 To UBound(arr1):
    dic.Add (arr1(I, 1)), 1 '"Нет в списке2"
Next
For I = 1 To UBound(arr2)
    If dic.Exists(arr2(I, 1)) Then
        dic(arr2(I, 1)) = 0 '"Есть в списке2"
        arr2(I, 2) = 0 '"Есть в списке1"
    Else
        arr2(I, 2) = 1 '"Нет в списке1"
    End If
Next
ReDim arr1(0 To dic.Count, 0 To 1): I = 0
For Each iKey In dic.Keys
    arr1(I, 0) = iKey
    arr1(I, 1) = dic(iKey)
    I = I + 1
Next
Range("G2").Resize(UBound(arr1) + 1, 2) = arr1
Range("L2").Resize(UBound(arr2), 2) = arr2
End Sub
Изменено: Sanja - 01.02.2019 09:27:08
Согласие есть продукт при полном непротивлении сторон
 
 
 
#10
01.02.2019 09:36:46
Цитата
Андрей VG написал: а где проверка значений первого массива, которых нет во втором
При заполнении словаря значениями бОльшего массива (в данном случае arr1), по умолчанию, каждой номенклатуре присваивается значение ОТСУТСТВИЯ этой номенклатуры во втором списке. Затем, при переборе второго массива и проверке его значений (номенклатур) на совпадение с ключами(номенклатурами) словаря, при совпадении, значение в словаре переписывается на ПРИСУТСТВИЕ  
Изменено: Sanja - 01.02.2019 10:05:19
Согласие есть продукт при полном непротивлении сторон
 
 
 
#11
01.02.2019 10:08:05
Андрей VG, Excel просто крашится при попытке обновить таблицу. Насчет эконом. обоснования - это слишком сложные слова для нашего IT-отдела)))

Sanja, Последняя версия макроса работает отлично! В результате была даже найдена одна номенклатура, которая по каким-то причинам была упущена Access'ом. Спасибо Вам огромное)
 
 
 
#12
01.02.2019 10:11:45
:) Пожалуйста
Согласие есть продукт при полном непротивлении сторон
 
 
 
#13
01.02.2019 10:36:23
Макрос похожий на код от Sanja, выводит на лист  "Номенклатура список расхождений" только расхождения. Работает в 2 раза дольше, чем код из сообщения №9, проверял на 400 тыс. строк
Скрытый текст
Изменено: Nordheim - 01.02.2019 10:37:19
"Все гениальное просто, а все простое гениально!!!"
 
 
 
#14
01.02.2019 11:56:17
Nordheim, Круто, отлично работает! Кстати, немногим медленнее, чем макрос из сообщения №9) Макрос Sanja на 810 и 815 тыс строк сработал за 644 секунды, а Ваш за 715 на тех же количествах.
Спасибо Вам огромное)
 
 
 
#15
01.02.2019 11:59:51
Пожалуйста  ;)
"Все гениальное просто, а все простое гениально!!!"
 
 
 
#16
01.02.2019 13:13:00
Цитата
Awallon написал:
Насчет эконом. обоснования - это слишком сложные слова для нашего IT-отдела)))
А чего там обосновывать? Оно ж бесплатное. Производитель сам M$, не сторонние разрабы. Как мотивируют отказ? Просто интересно. У вас бизнесом АйТишники что ли рулят?
Андрей VG, а вы не тестировали без Table.AddKey()? Сильно медленнее получалось?
Изменено: PooHkrd - 01.02.2019 13:44:51
Вот горшок пустой, он предмет простой...
 
 
 
#17
01.02.2019 14:05:27
Немного модернизировал, чтобы не привязываться к названиям листов.
Данные надо помещать в столбцы A и D и можно запускать макрос:
Код
Sub BigLists()'   -------------------------------
    Dim arr(), iarr(), txt$, I&
    Dim dic As Object, ikey
    Dim WS As Worksheet
    Const t1$ = "Нет в списке2"
    Const t2$ = "Нет в списке1"
    Dim Time1
'   -------------------------------
    Time1 = Time()
    Set dic = CreateObject("Scripting.Dictionary")
    arr = Range("A2:A" & Cells(Rows.Count, 1).End(xlUp).Row).Value
    iarr = Range("D2:D" & Cells(Rows.Count, 4).End(xlUp).Row).Value
    For I = 2 To UBound(arr)
        txt = arr(I, 1)
        dic.Item(txt) = t1
    Next I
    For I = 2 To UBound(iarr)
        txt = iarr(I, 1)
        If dic.Exists(txt) Then dic.Remove (txt) Else dic.Item(txt) = t2
    Next I
    Erase arr: I = 0
    ReDim arr(1 To dic.Count, 2)
    For Each ikey In dic.Keys
        I = I + 1
        arr(I, 0) = ikey
        If dic.Item(ikey) = t1 Then arr(I, 1) = t1 Else arr(I, 2) = t2
    Next ikey
    Sheets.Add
    With ActiveSheet
    .Name = "Рез_" & Format(Now(), "DD.MM.YYYY hh-mm-ss")
    .Cells.ClearContents
    .[a2].Resize(I, 3) = arr
    .[a1].Resize(, 3) = Array("Расхождения", t1, t2)
    .Columns.AutoFit
    End With
    hh = (Time() - Time1) / 3600
    mm = (Time() - Time1) / 60
    ss = (Time() - Time1)
    MsgBox "Готово!" & vbNewLine & "Время работы: " & Format(hh + mm + ss, "hh:mm:ss")
End Sub
Изменено: Awallon - 01.02.2019 14:06:42
 
 
 
#18
01.02.2019 14:10:10
PooHkrd, в отделе, в котором я работаю, вообще всё необходимо менять и модернизировать, но основной посыл на любые хотелки - у нас нет ни времени, ни ресурсов.  
 
 
 
#19
01.02.2019 14:24:35
OFF:
Awallon, ух ты, а я то думал в Ма-а-аскве все проблемы заливают баблом, закупая компы и софт направо и налево чуть возникла такая потребность. Остается вам только посочувствовать.
Вот горшок пустой, он предмет простой...
 
 
 
#20
01.02.2019 15:10:00
Цитата
PooHkrd написал: Awallon , ух ты, а я то думал в Ма-а-аскве все проблемы заливают баблом
Многие так думают, но в реалии все совсем по другому.
"Все гениальное просто, а все простое гениально!!!"
 
 
 
#21
01.02.2019 16:43:10
Цитата
PooHkrd написал:
Сильно медленнее получалось?
Одинаково получилось, хотя Крис уверял, что будет процентов 25 прирост. Быть может это на специфических задачах.
 
 
 
#22
01.02.2019 17:04:55
Андрей VG, Крис вроде показывал эту штуку на примере, агрегирования данных. А тут то обычных 2 АнтиДжойна. Вот я и удивился, к чему это здесь. Спасибо за ответ.
Вот горшок пустой, он предмет простой...
 
 
 
#23
01.02.2019 17:18:27
Цитата
PooHkrd написал:
агрегирования данных.
А есть существенная разница? По существу и там и там поиск совпадающих значений.
 
 
 
#24
01.02.2019 17:44:11
Андрей VG, да, если использовать тот пример, который он привел в статье, то разница в разы. Сам с таким сталкивался. Правда потом Максим показал мне пальцем в сторону Table.Join() + Table.Group() и оно как-то забылось. У меня есть парочка старых задачек, на которых возможно потестить Table.AddKey(). Как руки дойдут обязательно поделюсь в профильной теме в Курилке.
Вот горшок пустой, он предмет простой...
 
 
 
#25
02.02.2019 08:20:17
Коллекции однако пошустрее будут...
На словарях у меня все около 4 минут занимает, коллекция - 30 секунд

В файле сначала создаются списки (около 3 минут, примерно 800 000- 830 000 записей), затем проверяются через словари и коллекции.
 
 
 
#26
02.02.2019 14:06:02
Потестил одну из своих процедур ориентированную на поиск соответствия в двух списках с выводом в итоговвый массив кол-во найденных значений + массив индесов из массива, в котором ищем. поиск одного не упорядоченного списка текстовых значений в другом также не упорядоченном. Результаты по времени:
Скрытый текст

Тестовый макрос:
Скрытый текст

Сам поисковик.
Скрытый текст

П.С.: Если упростить процедуре задачу только на подсчет найденных значений между списками и урать проверку на длины строк, то должно получиться намного быстрее.
 
 
 
#27
02.02.2019 16:55:48
Попробовал из спортивного интереса решить эту задачу в Qlik. Т.к. дома только демо Sense - делал в нём.
Написать код и нарисовать визуализацию конечно занимает время, но в принципе можно визуализацию и не делать (выгружать результат сразу в файл на диск), а весь код вот:

Код
Лист1:
LOAD
   Список1,
   Список2
 FROM [lib://Downloads/Сравнение списков. ReadyTest.xlsm]
(ooxml, embedded labels, table is Лист1);

Map_1: Mapping   LOAD Список1, 'в обоих списках'  Resident [Лист1];
Map_2: Mapping   LOAD Список2, 'в обоих списках'  Resident [Лист1];

Результат:
load *,
ApplyMap('Map_1',Список2,'нет в списке1') as Сравнение2,
ApplyMap('Map_2',Список1,'нет в списке2') as Сравнение1
resident Лист1;

drop table Лист1;


Как источник использовал файл Михаила с сгенерёнными данными - добавил лист Лист1 с двумя озаглавленными столбцами.
Когда всё готово - данные обновляются со всем сохранением приложения после загрузки за 24 секунды.

http://prntscr.com/mfnlpo
http://prntscr.com/mfnowx

Цитата
Awallon написал:
Необходимо на регулярной основе сравнивать два списка номенклатур. Они огромные
- для такой задачи вполне: подменяй только списки, обновляй приложение.
Тут в примере выше я всё вывел в одну таблицу, т.е. в одной строке все данные по одной строке обоих списков.
На практике нужно делать две таблицы - тогда можно фильтрами отбирать что угодно в каждом списке отдельно.
http://prntscr.com/mfnu1h
Изменено: Hugo - 02.02.2019 17:08:25
 
 
 
#28
02.02.2019 18:36:44
Цитата
Awallon написал:
Насчет эконом. обоснования - это слишком сложные слова для нашего IT-отдела
тут нет экономического обоснования, только факт нежелания двигать попой. Наличие бесплатного инструмента для обработки больших массивов данных с целью анализа должно не убедить, но заставить задуматься ИТ. Я как ИТ говорю, ибо если пишут Производственная необходимость - идут лесом, а если видно что запрос хоть как то владеют вопросом, то всегда иду на встречу, если этот не противоречит безопасности и бюджету.
странно что не срабатывает SQL. Я не смотрел что сделал Андрей, но можно зарос перенести в access, где таблицы excel прилинковать. Сделать в нем Query, а уже из Excel вызывать это Query простым SELECT * from QueryName
По вопросам из тем форума, личку не читаю.
 
 
 
#29
02.02.2019 23:29:02
Цитата
БМВ написал:
странно что не срабатывает SQL
Привет, Михаил.
Мало ли. У меня вчера от на миллионе строк 5 минут висел в Excel 2010 32бит. Убил не дождавшись. На мелочи отработал без проблем. А сам SQL - ничего сложного, обычный union двух anti lefti join.
 
 
 
#30
03.02.2019 13:44:39
А этот код вручную написан? Только конструктором такое сопоставление можно провести?
Код
let
    tbl1 = Table.AddKey(Excel.CurrentWorkbook(){[Name="Таблица1"]}[Content], {"Поле1"}, true), 
    tbl2 = Table.AddKey(Excel.CurrentWorkbook(){[Name="Таблица2"]}[Content], {"Поле2"}, true), 
    onlyTbl1 = Table.Join(tbl1, {"Поле1"}, tbl2, {"Поле2"}, JoinKind.LeftAnti)[[Поле1]], 
    onlyTbl2 = Table.Join(tbl1, {"Поле1"}, tbl2, {"Поле2"}, JoinKind.RightAnti)[[Поле2]], 
    markTbl1 = Table.AddColumn(Table.RenameColumns(onlyTbl1, {"Поле1", "Поле"}), "№ таблицы", each 1), 
    markTbl2 = Table.AddColumn(Table.RenameColumns(onlyTbl2, {"Поле2", "Поле"}), "№ таблицы", each 2) 

in
    markTbl1 & markTbl2 // объединяем столбцы
Изменено: Djinn - 03.02.2019 13:44:52
 
 
 
Страницы: 1 2 След.
Наверх