Сравнение значений на двух листах, более 80 000 строк.

[Hoochara]

Добрый день.

Помоги пожалуйста решить вот такую проблему.
Во вложении фаил. В нем 2 листа - лист База и лист Raw

Задача вот какая
Необходимо сравнить столбец Сцепка в листе Raw
со столбцом Сцепка листа База.
Если сцепка листа Raw равна сцепке листа база, то в зависимости от того какой в столбце номер года(6 столбец листа Raw) переносить значения из листа Raw на лист база в столбец либо 8 (если 2012 год) либо в 9 (если 2011 год).
Если такая сцепка не нашлась в листе База, то в нижнюю пустую строку переносить строку из листа Raw

Я написал макрос,который загоняет сцепки листа раф и база в 2 массива, и потом сравнивал их в цикле, но макрос делает ОЧЕНЬ долго, нужно 60 000 строк сравнить каждую 80 000 раз.
Помогите пожалуйста



--------- примечание модератора - вдруг кому пригодится --------------

Надстройка LOOKUP предназначена для сравнения и подстановки значений в таблицах Excel.

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

В настройках программы можно задать:

• где искать сравниваемые файлы (использовать уже открытый файл, загружать файл по заданному пути, или же выводить диалоговое окно выбора файла)
• с каких листов брать данные (варианты: активный лист, лист с заданным номером или названием)
• какие столбцы сравнивать (можно задать несколько столбцов)
• значения каких столбцов надо копировать в найденные строки (также можно указать несколько столбцов)

Скачать надстройку для сравнения таблиц Excel и копирования данных из одинаковых строк

[Hugo121]

Не видно Вашего макроса.
Такие объёмы нужно словарём обрабатывать - будет не "60 000 строк сравнить каждую 80 000 раз", а всего по одному проходу по каждому массиву и 60 000 (ну ли 80 000) моментальных поисков в словаре.
Образец кода для переделки:

Option Explicit

'Макросом -
'1.два диапазона в два массива
'2.создание массива для результатов
'3.один перебор n значений массива в словарь
'4.m проверок массива на наличие в словаре и заполнение данными массива результата
'5.выгрузка результатов (тут нет предварительной очистки диапазона)

Sub compare()
    Dim a(), b(), c(), iLastrow As Long, i As Long, ii As Long

    '1.
    With Sheets(1)
        iLastrow = .Cells(Rows.Count, 1).End(xlUp).Row
        a = Range(.[b1], .Range("A" & iLastrow)).Value
    End With

    With Sheets(2)
        iLastrow = .Cells(Rows.Count, 1).End(xlUp).Row
        b = Range(.[b1], .Range("A" & iLastrow)).Value
    End With

    '2.
    ReDim c(1 To UBound(a), 1 To 3)

    With CreateObject("Scripting.Dictionary")
    
        '3.
        For i = 1 To UBound(b)
            .Item(b(i, 1)) = i
        Next

        '4.
        For i = 1 To UBound(a)
            If .exists(a(i, 1)) Then
                ii = ii + 1
                c(ii, 1) = a(i, 1)
                c(ii, 2) = a(i, 2)
                c(ii, 3) = b(.Item(a(i, 1)), 2)
            End If
        Next
    End With

    '5.
    With Sheets(3)
        .[A1].Resize(ii, 3) = c
        .Activate
    End With

End Sub

Подправьте диапазоны, сделайте результирующий массив на два столбца, добавьте проверку года и в зависимости от этого копирование.

[Hoochara]

Подставил свои значения, но как я понимаю перебор идет парарельных значений? Грубо говоря у меня нашлись только 2 одинаковые строки это превая строка в 1 и во 2 листе содержат название Сцепка.

Нашел свою ошибку, извиняюсь)

[Hugo121]

Ну примерно вот так:

Option Explicit

'Макросом -
'1.два диапазона в два массива
'2.создание массива для результатов
'3.один перебор n значений массива в словарь
'4.m проверок массива на наличие в словаре и заполнение данными массива результата
'5.выгрузка результатов (тут нет предварительной очистки диапазона)

Sub compare()
    Dim a(), b(), bb(), c(), iLastrow As Long, i As Long, t&
    Dim tm!: tm = Timer

    Application.ScreenUpdating = False

    '1.
    With Sheets(1)
        iLastrow = .Cells(Rows.Count, 13).End(xlUp).Row
        a = Range(.[M1], .Range("M" & iLastrow)).Value
        c = Range(.[I1], .Range("J" & iLastrow)).Value  '2.
    End With

    With Sheets(2)
        iLastrow = .Cells(Rows.Count, 11).End(xlUp).Row
        b = Range(.[K1], .Range("K" & iLastrow)).Value
        bb = Range(.[F1], .Range("H" & iLastrow)).Value
    End With

    With CreateObject("Scripting.Dictionary")

        '3.
        For i = 1 To UBound(b)
            .Item(b(i, 1)) = i
        Next

        '4.
        For i = 1 To UBound(a)
            If .exists(a(i, 1)) Then
                t = .Item(a(i, 1))
                Select Case bb(t, 1)
                Case 2011: c(i, 1) = bb(t, 3)
                Case 2012: c(i, 2) = bb(t, 3)
                End Select
            End If
        Next
    End With

    '5.
    Sheets(1).[I1].Resize(UBound(c), 2) = c

    Application.ScreenUpdating = True

    MsgBox "Ready in " & Round(Timer - tm, 3) & " s"

End Sub

Только у меня на 2003 совпадений не нашлось. Вернее одно - заголовок совпадает
Хотя Вы уже и сами проверили.
Ну и тестовое специально последнее сделал - данные вытянулись.
На всё 2 секунды.