Синхронизация таблиц

[bulbul]

Существует две таблицы в одной книге, таблица А(Лист1) и таблица Б(Лист2). Необходимо сравнить их по первым 12 столбцам, таким образом, что при !несовпадении! данных в этих столбцах, данные добавляются из табл.Б в табл.А.

Почти такая же тема существовала-http://programmersforum.ru/showthread.php?t=27281, только я совсем забыл написание макросов и не знаю как добавить сразу все столбцы, если кто нибудь сможет помочь отредактировать скрипт буду очень благодарен!!!

[doober]

Я думаю,этот файл вам может подойти.
Там сравнение идет по всем столбцам

[bulbul]

К сожалению не работает

[bulbul]

Добавлять необходимо строки, которые различаются...
Постараюсь рассказать подробнее:
1) Существуют 2 базы, они практически идентичны(шапки у них одни и те же), но редактировались разными людьми, соответственно там могут быть отличия
2) Необходимо, чтобы строки отсутствующие в первой базе подтянулись в нее из 2-ой
Как автоматизировать процесс не знаю...

[Hugo121]

Всё стало только непонятнее...

[bulbul]

Постараюсь объяснить еще раз
1)есть 2 базы данных
2)эти базы-прайс листы(там содержится номенклатура, цена, название и.т.д.)
3)необходимо из одной базы данных вытащить отличающиеся строки, чтобы одна база данных дополнила другую.
Думаю теперь идея более четко сформулирована?

[Hugo121]

Нет.
1. Там и близко нет похожих строк, и судя по примеру - и быть не могут, т.к. заводятся разные подразделения.
Т.е. просто копипастим всё в кучу столбиком, и порядок. Можно несложным макросом.
2. Почему собираете только 2 суммы и одну выборочную строку?
3. Если в собираемых данных будут 2 одинаковые строки (такого быть не может?) - что делать?

В 2007 вручную можно так - сваливаете всё на один лист, затем в свободном столбце собираете вместе данные столбцов-критериев (например через & "|" &), затем инструментом "удалить дубликаты" по этому столбцу удаляете лишнее.

Вообще макросом можно сделать так - циклом по сводному диапазону как критерий собираем вместе значение нужных ячеек строки, заносим его в словарь (тут повторов быть не должно).
Затем циклом по собираемым диапазонам аналогично собираем критерий, проверяем его по словарю - если нет, то заносим в словарь и копируем строку. Если уже есть - пропускаем и идём дальше.
Для скорости работаем не с листами, а с массивами данных с этих листов, и отбираем данные в массив, который в конце выгружаем.
Сделать не сложно - но:
1. не понятно, что именно нужно
2. делать не интересно - таких кодов на форуме по паре за неделю уже было...

[bulbul]

1.Я просто для примера показал, что макрос не работает-перенес разные данные, а он их не свел.
2.Данные просто вырезаны
3.Задача добавить НЕ ИДЕНТИЧНЫЕ строки в первую табличку(если была бы возможность, то еще цвет добавленных строчек поменять)

Вот пример 2 табличек-Лист1 и Лист2, необходимо из Листа2 перенести строки которых нет в Листе1.

[doober]

Если внести изменения ,то все работает.Правте под себя.

Sub ComprareX(D02)
        Dim X01() As Comprarer, X02() As Comprarer
        Dim D01, paralast As Long, Sl As String, X As Range
        Dim Sh As Worksheet
        Set Sh = ThisWorkbook.Worksheets("носитель")
        D01 = Sh.UsedRange
        ReDim X01(UBound(D01, 1)): ReDim X02(UBound(D02, 1))

        For n = 2 To UBound(D01, 1)
                Sl = ""
                For m = 2 To UBound(D01, 2)
                        Sl = Sl & D01(n, m) & "@"
                Next
                If D01(n, 1) <> "" Then
                        X01(n).key = D01(n, 3)
                        X01(n).Row = n
                        X01(n).stroka = Sl
                End If
        Next
        For n = 2 To UBound(D02, 1)
                Sl = ""
                For m = 2 To UBound(D02, 2)
                        Sl = Sl & D02(n, m) & "@"
                Next
                If D02(n, 1) <> "" Then
                        X02(n).key = D02(n, 3)
                        X02(n).Row = n
                        X02(n).stroka = Sl
                End If
        Next
With Sh
        For n = 2 To UBound(X02)
                If X02(n).key <> "" Then
                        Set X = .Columns(3).Find(X02(n).key, LookIn:=xlValues, LookAt:=xlWhole)
                        If Not X Is Nothing Then
                                If X02(n).stroka <> X01(X.Row).stroka Then
                                        For m = 2 To UBound(D02, 2)
                                               .Cells(X.Row, m) = D02(n, m)
                                        Next
                                End If
                                Else
                           paralast = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
                                  For m = 1 To UBound(D02, 2)
                                .Cells(paralast, m) = D02(n, m)
                                  Next
                        End If

                End If
        Next

End With
End Sub

[bulbul]

Большое спасибо!!!
Только с большой базой около 6 тыс строк каждая не работает
Пишет - Subsript out of range
если это было бы возможно, можно было бы в файле прислать?