Сравнить и сложить книги

[Rolls]

Здравствуйте все!
Возникла одна задача, очень долго ковырял функцию FIND, и всё никак ..
Буду очень признателен за помощь!
В общем задача следующая : есть два файла, в каждом около 6 тыс.строк. Один файл постоянный, во втором со временем добавляются строки. Нужно из первого файла запустить такой макрос, чтобы он проверил второй файл и вписал все недостающие строки в первый файл. Сравнение происходит по одному столбцу.
Заранее благодарен!

[Hugo121]

Открыть второй файл и savecopyas первый не годится? Почему?

Если не годится - изучайте словари и массивы.
1.Критерии первого файла в массив->цикл по массиву->заносим в словарь
2.Критерии второго файла в массив->цикл по массиву->проверяем наличие в словаре
3.Если нет в словаре - копируем исходную строку (или копируем из массива в новый пустой маcсив, что быстрее, в итоге выгружаем его под данными).

Если новых строк бывает не много - то копируйте строки с листа на лист, от промежуточного массива выигрыш не почувствуете (а форматы потеряете).
Но массивы с критериями юзать желательно - всёж 6000 строк, уже может подтормаживать, если ячейки листа перебирать.

[Rolls]

пытаюсь сделать что-то вот с таким циклом, работает! но в точности наоборот ) добавляет в первую книгу значения ПЕРВОЙ книги те, которых нет во второй
пока не разобрался, может кто увидит ошибку?

    Z = 1
    For y = 2 To wB.Sheets("ïðàéñ").Cells(Rows.Count, 1).End(xlUp).Row
        If Z = 0 Then
            Cells(Cells(Rows.Count, 1).End(xlUp).Row + 1, 1).Value = wB.Sheets("ïðàéñ").Cells(y, 1).Value
            Cells(Cells(Rows.Count, 1).End(xlUp).Row, 2).Value = wB.Sheets("ïðàéñ").Cells(y, 2).Value
            Cells(Cells(Rows.Count, 1).End(xlUp).Row, 3).Value = wB.Sheets("ïðàéñ").Cells(y, 3).Value
            Cells(Cells(Rows.Count, 1).End(xlUp).Row, 4).Value = wB.Sheets("ïðàéñ").Cells(y, 4).Value
        End If
        Z = 0
        For i = 2 To Cells(Rows.Count, 1).End(xlUp).Row
            If wB.Sheets("ïðàéñ").Cells(y, 3).Value = Cells(i, 3).Value Then
                Z = 1
                Exit For
            End If
        Next
    Next

[Hugo121]

Можно конечно и так делать (когда наладите этот китайский код - по мне его нужно собрать из этих строк заново наоборот буквально во всём ), но т.к. у Вас 6000 строк в каждом файле, в этом варианте придётся сравнить/перебрать 36000000
ячеек, чтоб скопировать затем 4 (ну или сколько там строк не найдётся). Даже с учётом выхода из цикла - там ведь выход будет в самом конце перебора. Хоть бы цикл в обратную сторону пускал .
Плюс ещё на каждое копирование ячейки определяется последняя строка (хватило бы определить один раз), но это мелочи - не так ведь часто копируем...
Когда сделаете - напишите здесь, за какое время пройдёт операция.

[Rolls]

            Cells(Cells(Rows.Count, 1).End(xlUp).Row + 1, 1).Value = wB.Sheets("ïðàéñ").Cells(y, 1).Value
            Cells(Cells(Rows.Count, 1).End(xlUp).Row, 2).Value = wB.Sheets("ïðàéñ").Cells(y, 2).Value
            Cells(Cells(Rows.Count, 1).End(xlUp).Row, 3).Value = wB.Sheets("ïðàéñ").Cells(y, 3).Value
            Cells(Cells(Rows.Count, 1).End(xlUp).Row, 4).Value = wB.Sheets("ïðàéñ").Cells(y, 4).Value

Добавил здесь к каждому "Y" "-1" , всё заработало, операция прошла за 5 минут (Intel Core 2 Duo 2.8 ГГц) .
Согласен, это самый примитивный вариант, т.к. в VBA Я вообще ни в зуб ногой.
Если не сложно, буду очень признателен если выложите оптимизированный рабочий код. только так, чтоб можно было Copy-Paste, по той же самой причине, что в VBA ни в зуб ногой, и править его будет крайне сложно

[Hugo121]

Если бы Вы показали примеры своих файлов (строк так на 10 каждый, с парой/тройкой повторов, больше не нужно) - то я наверное нашёл бы 5/10 минут для кода на словаре.
Теперь уже вероятно только вечером дома время смогу выкроить.
Но Вы показывайте (с Вашим кодом для сравнения) - может кто другой быстрее ответит. И думаю ответили бы, если бы файлы были.
Никому не охота рисовать файлы, ориентрируясь на догадки и Ваш кривой код...

Да, на словаре думаю секунды 2 нужно на всё. Ну правда смотря сколько строк нужно копировать - 2 это на штук 10 строк... Т.к. основное время займёт не поиск, а именно копирование.

Хотя есть вариант копировать сразу все найденные за один заход, или копировать данные из массива в массив и выгружать снизу его (если цвет/заливка не важны, но так проще и быстрее) - тогда хоть на 5000 новых строк время будет примерно одинаково (+- пара секунд).

[Rolls]

Не вопрос, вот файлы.
В файле "Книга1.xlsm" есть два скрипта.
Один из них (add_Item) добавляет строки из "книга2.xls" в "книга1.xls".
Второй (add_pic) добавляет ссылки на картинки в "книга2", что занимало около 4х минут, и добавляет ещё две колонки вычисляя их по формулам, после этого макрос стал выполняться (внимание) 40 минут!!!
Собственно буду больше признателен, если поможете оптимизировать второй скрипт (add_items)

[Rolls]

Понял 1ую ошибку : формулы к каждой строчке применяются по 6 000 раз
Кстати скрипты изначально были скопированы с этого же форума в теме http://programmersforum.ru/showthread.php?t=86887 я посто как сумел модифицировал циклы под свои нужды. Так что до циклов может быть много чего лишнего.

[Hugo121]

add_items - это уже третий макрос. Которого нет!
Так который скрипт нужно исправить?

И кстати зачем такие формулы заносите по-одной? Заносите автозаполнением, если нужно - можно затем сразу все заменить на значения.
Вернее там не формулы, а значения (файлы перепутал) - но их ведь можно занести формулами автозаполнением и затем заменить если нужно на значения.
Зачем выход из цикла - не понял... Полтаблицы заполнило, дальше пусто...

[Rolls]

Сообщение от Hugo121

Зачем выход из цикла - не понял... Полтаблицы заполнило, дальше пусто...

выход из цикла был добавлен ещё до строчек с формулами, не уследил потом.

Сообщение от Hugo121

И кстати зачем такие формулы заносите по-одной? Заносите автозаполнением,

Что есть "автозаполнение" ? Сделал как мог методом тыка, функций VB (и Excel) абсолютно не знаю. Если автозаполнение мнее ресурсоёмкое, буду рад увидеть его в скрипте

Сообщение от Hugo121

Так который скрипт нужно исправить?

Исправить нужно скрипт add_pics в книге1. Результатом должно быть добавление в книга2 5го и 6го столбцов по формулам, и 7го столбца из книга1 при сходстве ячеек в 3 солбце (ссылки на картинки)