Страницы: 1
RSS
Как при помощи массивов быстро собрать список уникальных элементов?
 
Добрый день.

Вопрос такой - есть около 200-300 файлов с несколькими листами на которых даны перечни товаров на 50-100 тыс строк.
Требуется написать макрос чтобы собрать со всех листов всех файлов)  названия товара без повторов (а они процентов на 20-40% могут повторяться)
Пробовал без использования массивов - работает очень медленно (суммарно объем данных может быть 5-10 млн строк)
С массивами дошел до задания массивов хранения результата:
Код
Dim arrM2(1048576, 14)
Dim arrM3(1048576, 14)

....
задании рабочего массива в котором произвожу работу с открытым по очереди файлом
Код
Dim arrM1()
arrM1 = Range(Cells(1, 1), Cells(1048576, 20))


Если просто копировать целиком из открытого файла таблицу в приготовленные массивы проблем нет (с отбором по статичной маске тоже).
А как на этом этапе организовать контроль наличия в имеющемся собранном наборе данных данных из новой таблицы чтобы не копировать то что уже там есть?

Нашел поиском тему с примером:
Код
Sub test()    Dim myArray As Variant
    myArray = Array("a", "c", "d")

    Dim word As Variant        
    For Each word In myArray
        Sheet1.Range("A1:A11").Find(word).Interior.ColorIndex = 15            
    Next word
End Sub

но пока без помощи не разобрался насколько это подходит под мою задачу.

Спасибо.
 
Массив около 300 * 50 000 , а строк на листе всего 1 048 576...
 
Цитата
Сергей написал:
как на этом этапе организовать контроль наличия в имеющемся собранном наборе данных данных из новой таблицы чтобы не копировать то что уже там есть?
If в помощь  :)
 
размер массива задавать не надо: определять последнюю занятую ячейку и считывать в массив
А потом в словарь уникальные. Можно и без If
а красить зачем?
вот пример перебора всех файлов в папке. Добавить открытие книги, перебор листов и обработку массивов
Код
Function Get_Item(Path_)
 Set C_is = CreateObject("scripting.dictionary")
        Dim Path As String
        Set oFSO = CreateObject("Scripting.FileSystemObject")
        Dim strFile As String, strFile2 As String
        Set FSO = CreateObject("scripting.filesystemobject")
        Set curfold = FSO.GetFolder(Path_)
        If Not curfold Is Nothing Then
                For Each fil In curfold.Files
                        If InStr(1, fil.Name, ".xls", vbTextCompare) > 0 Then
                                C_is.Item(fil.Name) = fil.Path
                        End If
                Next
        End If
        Set FSO = Nothing
        Get_Item = C_is.items
  
End Function
Изменено: Александр Моторин - 04.01.2021 19:01:15
 
Цитата
Александр Моторин написал:
красить зачем?
Тоже хотел спросить, но постеснялся, т.к. ТС  
Цитата
Сергей написал:
не разобрался насколько это подходит под мою задачу
:) Возможно, задача в другом и массивы не при чем :)
Off: Пробовал как-то обойтись без словаря (чисто из вредности - чтобы не применять Dictionary - выгружал в массив по условию, а потом сравнивал с другим массивом, по времени работало сносно (сотые и тысячные секунды не измерял, а визуально в секундах было примерно также как через словарь, но это было лет пять назад, а в современных компах наверное и не почувствуешь), поэтому и решил упомянуть старое доброе If :)
 
Цитата
_Igor_61 написал:
а потом сравнивал с другим массивом
хмм...
Цитата
суммарно объем данных может быть 5-10 млн строк
и цикл в цикле проверять?
Я не уверен, что 10 лимонов строк не вызове ошибки
 
Цитата
_Igor_61 написал:
но это было лет пять назад, а в современных компах наверное и не почувствуешь)
Должно чувствоваться, ибо словарь вроде индексируется, да и работает на более низком уровне, а массив - перебор каждый раз и на уровне VBA.

А чего это  PQшники затихорились?  
Изменено: БМВ - 04.01.2021 20:48:39
По вопросам из тем форума, личку не читаю.
 
заполнение массива 10000 х 1000 (10000000 значений) рандомными числами и выбор из них 8000000+ уникальных словарём заняло почти час
но 8 лимонов в словарь влезло
 
Доброе время суток
Цитата
БМВ написал:
А чего это  PQшники затихорились?  
Полагаю из-за этого
Цитата
2.3. Приложите файл(ы) с примером (общим весом не более 300Кб) в реальной структуре и форматах данных того, что есть сейчас и того, что хотелось бы на выходе.
 
ADO + SQL в помощь
Спасибо
 
Цитата
Андрей VG написал:
Полагаю из-за этого
Андрей, ну не в примере дело. Чисто гипотетически, собрать файлы и уникальные вывести - не проблема ведь.
Цитата
R Dmitry написал:
ADO + SQL
Предлагаете последовательно или сразу объединять?  
По вопросам из тем форума, личку не читаю.
 
Кому не нравится словарь (или кто маковод) - есть ведь родные коллекции! Только конечно юзать с ключами, и может прямо в ней всё и собирать, для названий вполне достаточно.
Или это пунктик такой - вот только массивы и никаких других компонентов?
Изменено: Hugo - 04.01.2021 23:22:45
 
Цитата
БМВ написал:
собрать файлы и уникальные вывести - не проблема ведь.
Согласен, не проблема. И Power Query решений на форумах и статей в инете - полно. Тогда я не понял причём тут камушек
Цитата
БМВ написал:
А чего это  PQшники затихорились?  
 
Цитата
Андрей VG написал:
причём тут камушек
Да просто не слова о этом никто не написал . Правда согласен с
Цитата
Hugo написал:
вот только массивы и никаких других компонентов?
в вопросе разговор только о массивах.
По вопросам из тем форума, личку не читаю.
 
Думаю, вам эта тема будет полезна
https://www.planetaexcel.ru/forum/index.php?PAGE_NAME=read&FID=1&TID=110554
Закачивание в один массив, уделяете дубликаты. Всё.
Думаю сортировка и удаление дубликатов на 10 млн. строк в несколько сек. успеем (вместо часа)
Изменено: bedvit - 05.01.2021 21:14:37
«Бритва Оккама» или «Принцип Калашникова»?
 
Цитата
Александр Моторин: выбор из них 8000000+ уникальных словарём заняло почти час
проверено, что после 100 тыс КЛЮЧЕЙ, скорость работы словаря РЕЗКО падает, практически уничтожая выгоду от его использования
Увеличение количества словарей может чуть-чуть помочь, но вариант с сортировкой массива и последующим бинарным поиском по нему - гораздо лучше  :idea:
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
Страницы: 1
Наверх