поиск совпадений в 2 столбцах

[Elpando]

Всех категорически приветствую! Тема такая: есть 2 столбца с данными (А и В). В столбце А около 10000 позиций, в столбце В тоже около 10000 позиций, но с изменениями (некоторые позиции удалены или добавлены). Так вот нужно произвести поиск и найти "непарные" позиции, т.е. те, которые есть либо только в столбце А, либо только в столбце В. И если эти "непарные" еще и подсветятся в столбцах, то с меня еще бОльшее спасибо за помощь) Я в excele совсем не разбираюсь, но жизнь заставила :-)

[Watcher_1]

Ловите

Sub m()
    Dim myF As Range
    i = 0
    Do
        i = i + 1
        If Range("A" & i) = "" And Range("B" & i) = "" Then Exit Do
        DoEvents
        Set myF = Columns(2).Find(Range("A" & i), , , xlWhole)
        If myF Is Nothing Then Range("A" & i).Interior.Color = vbRed
        Set myF = Columns(1).Find(Range("B" & i), , , xlWhole)
        If myF Is Nothing Then Range("B" & i).Interior.Color = vbRed
    Loop
End Sub

[Elpando]

спасиииииибо Watcher_1! помог! с меня пиво :-)

[Hugo121]

10000*10000 find'ами гонять? И красить...
Долго... Если много несовпадений - может и на час затянуться.
И затем нужно будет пару часов, чтоб глазами цвета отбирать - ещё не у всех 2007

[Watcher_1]

Уважаемый Hugo121
Согласен код далек от идеала.
НО с 10000*10000 вы загнули!!!
Вы наверное имели ввиду 10000*2?

[Elpando]

а есть предложения лучше? не откажусь от быстрого поиска)

[Watcher_1]

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

спасиииииибо Watcher_1! помог! с меня пиво :-)

Для меня и + будет достаточно...

[Hugo121]

Да, с часом загнул - всего лишь 2 минуты работало.
Ну а 10000*10000 это даже мало - сперва 10000 раз искать по второй 10000, затем (т.е. параллельно перекрёстно) будет искать наоборот. Хотя это конечно быстрее чем цикл в цикле

Ну а быстрый вот - но без покраски. Зачем она?

Sub tt()
    Dim tm: tm = Timer
    Dim a(), dic1 As Object, dic2 As Object
    Dim x&, y&

    a = [a1].CurrentRegion.Value
    ReDim b(1 To UBound(a), 1 To 2)
    b(1, 1) = "есть только в первом"
    b(1, 2) = "есть только во втором"
    x = 1: y = 1
    Set dic1 = CreateObject("scripting.dictionary")
    Set dic2 = CreateObject("scripting.dictionary")

    For i = 1 To UBound(a)
        dic1.Item(a(i, 1)) = 0&
        dic2.Item(a(i, 2)) = 0&
    Next

    For i = 1 To UBound(a)
        If Not dic2.exists(a(i, 1)) Then x = x + 1: b(x, 1) = a(i, 1)
        If Not dic1.exists(a(i, 2)) Then y = y + 1: b(y, 2) = a(i, 2)
    Next

    [d1].Resize(Application.Max(x, y), 2) = b
    Debug.Print Timer - tm
End Sub

Покраску добавить легко - координаты ячейки есть, пример покраски в коде Watcher_1
Как бонус - таймер.

[Step_UA]

Если ТС достаточно покраски или как дополнение к коду Hugo121 - использовать условное форматирование ...

[doober]

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

Уважаемый Hugo121
Согласен код далек от идеала.
НО с 10000*10000 вы загнули!!!
Вы наверное имели ввиду 10000*2?

Разве
10000*10000 и 10000*2 -это не одно и то же.
Или визуально нулей меньше.