Сравнение больших столбцов

[Oleg121]

есть задача - 2 столбца с числами. требуется сравнить значения из 2-го столбца со значениями из первого, и если есть совпадение, то совпадающее значение из первого выделить цветом. макрос работает, но проблема в том, что столбцы очень большие (количество строк измеряется сотнями тысяч), из-за чего вычисление занимает много времени. есть ли какие-то другие алгоритмы сравнения, занимающие меньше времени? заранее спасибо за ответы.
мой макрос

PHP код:

For j = 1 To n
 For i = 1 To m
   If Cells(i, 1).Value = Cells(j, 2).Value Then Cells(j, 1).Font.Color = RGB(255, 0, 0)
 Next
Next 


[Hugo121]

Зачем выделять цветом?
Основной тормоз будет именно в этом - хотя значительно этот код ускорить можно.
А если не красить, а отбирать - то даже не знаю, во сколько раз можно ускорить... раз в 1000...10000...1000000 вероятно.

P.S. Вот с покраской:

Sub compare()
    Dim a, i&
    Application.ScreenUpdating = False
    With CreateObject("Scripting.Dictionary")
        .CompareMode = 1

        a = Sheets(1).[a1].CurrentRegion.Value
        For i = 1 To UBound(a)
            .Item(a(i, 2)) = vbNullString
        Next
        For i = 1 To UBound(a)
            If .exists(a(i, 1)) Then Cells(i, 1).Font.Color = RGB(255, 0, 0)
        Next

    End With
    Application.ScreenUpdating = True
End Sub

Можно покраску тоже ускорить - не красить сразу, а проставлять в созданный пустой массив под размер единицы в эти позиции.
Затем выгрузить массив рядом в свободный столбец, отфильтровать по единицам, сразу покрасить все видимые, убрать фильтр и единицы.
Реализовывать лениво

[Oleg121]

Каким образом отбирать? переносить в другое место? если можно с примером

[DiemonStar]

Условное форматирование может стоит попробовать?)

[Rom1k06]

Еще более простой способ.
A1=B1 будет истина или ложь.
данные - фильтр истина и выделяй, закрашивай и т.д.

[Hugo121]

Отбор в другое место:

Sub compare2()
    Dim a, i&, ii&
    Application.ScreenUpdating = False
    With CreateObject("Scripting.Dictionary")
        .CompareMode = 1

        a = Sheets(1).[a1].CurrentRegion.Value
        ReDim b(1 To UBound(a), 1 To 1)
        
        For i = 1 To UBound(a)
            .Item(a(i, 2)) = vbNullString
        Next
        For i = 1 To UBound(a)
            If .exists(a(i, 1)) Then
            ii = ii + 1
            b(ii, 1) = a(i, 1)
            End If
        Next

    End With
    [d1].Resize(ii, 1) = b
    Application.ScreenUpdating = True
End Sub

Отбирает с повторами - если повторы не нужны, то можно сразу после отбора числа удалять его из словаря. Тогда повторно не отберётся.

P.S. УФ или формулы на сотни тысяч?