Сравнения двух книг и запись уникальных на новую - VBA

Формулировка задачи:

Здравствуйте. Не пинайте если вопрос таков был я очень долго искал почти месяц не нашел. есть две книги книга1.xlsx и книга2.xlsx в которых сдержаться данные в этих книгах нужно сравнит данные и вывести уникальные. В книгах такие данные. первая ячейка A1 содержит номер телефона, в ячейке B1 еще один номер, в ячейке С1 секунды. В книге2 такие же данные, но секунды могут быт на 1 больше или меньше. Нужно провести поиск и тоест сверит данные с книги 1 и если в книге два есть ети данные пропустит, а если нет сделать поиск заного но уже со второй строки тоест из a2 b2 c2. Мои действия: В новой книге сделал сцепку данных с книги A1 B1 C1 а рядом данные с книги 2 также. и написал поиско3(A1;b1:b300000;0) все работает но так как данныз 3000000 то данные расчитываются почти по 6 часов это очень медленно к меня комп I7 8 ядер. 6 г оперативка. Прилагая книгу в которой все готово формулу не растягиваю до конца в прилагаемом файле иначи у вас будет открыват долго если не зависит.

Решение задачи: «Сравнения двух книг и запись уникальных на новую»

textual
                            Листинг программы 
                        

                            Option Explicit
 
Sub tt()
    Dim a, b, i&, t$, tt$, k
    With CreateObject("scripting.dictionary"): .comparemode = 1
        a = Workbooks("Книга1").Sheets(1).[a1].CurrentRegion.Value
        For i = 2 To UBound(a)
            .Item(a(i, 1) & "|" & a(i, 2) & "|" & a(i, 3)) = i
        Next
        b = Workbooks("Книга2").Sheets(1).[E1].CurrentRegion.Value
        For i = 2 To UBound(b)
            Do
                tt = b(i, 1) & "|" & b(i, 2) & "|"
                t = tt & b(i, 3)
                If .exists(t) Then .Remove (t): Exit Do
                t = tt & (b(i, 3) - 1)
                If .exists(t) Then .Remove (t): Exit Do
                t = tt & (b(i, 3) + 1)
                If .exists(t) Then .Remove (t)
                Exit Do
            Loop
        Next
 
        ReDim b(1 To .Count + 1, 1 To 3): i = 1
        b(1, 1) = "A num": b(1, 2) = "B num": b(1, 3) = "sec"
        For Each k In .items
            i = i + 1
            b(i, 1) = a(k, 1): b(i, 2) = a(k, 2): b(i, 3) = a(k, 3)
        Next
    End With
 
    With Workbooks.Add(1).Sheets(1).[a1].Resize(i, 3)
        .Columns(1).Resize(, 2).NumberFormat = "0"
        .Value = b
        .Columns.AutoFit
    End With
End Sub
                        