Страницы: 1
RSS
Поиск макросом дубликатов в двух столбцах, Поиск дубликатов в двух столбцах с помощью макроса
 
Задача на первый взгляд простая: найти дубликаты в двух столбцах, подкрасив одним цветом (например, зелёным) (в примере Лист "Так надо").  
Однако, стандартная фишка "Условное форматирование/Правила выделенных ячеек/Повторяющиеся значения" работает не корректно для моей задачи, поскольку выделяет и те дубли, которые содержатся в одном столбце (в примере Лист "Условное форматирование" цифры 45673). К тому же замечено, что условное форматирование большого количества ячеек в сочетании с Автофильтром - долго очень отрабатывает (Excel "виснет").
Подскажите, пожалуйста, код макроса, решающий эти проблемы, в обход условного форматирования.
Благодарю!
 
УФ
Всё сложное - не нужно. Всё нужное - просто /М. Т. Калашников/
 
ошибка, надо поправить
Изменено: Evick - 08.10.2015 20:25:43 (ошибочка в файле)
 
Если макросом то можно так
Код
Sub unicolor()
Dim c As Range
Set r = Union([a2..a9], [c2..c8])
Set d = CreateObject("scripting.dictionary")
For Each c In r
If Not d.exists(c.Value) Then
Set d(c.Value) = c
Else
c.Interior.Color = 65535
d(c.Value).Interior.Color = 65535
End If
Next
End Sub
 
Цитата
Evick написал:
ошибка, надо поправить
Да, бы! )
1) нули и пустые не нужно закрашивать;
2) переставлять строки не нужно, а только закрашивать зелёным дубли.
 
Цитата
B.Key написал:
Если макросом то можно так
Работает не совсем так, как нужно:
1) выделяет дубли чисел, которые встречаются в одном столбце;
2) при запуске макроса нужно снимать закраску после предыдущего запуска макроса.
 
aesp, а чем Вас УФ от уважаемого Михаил Лебедев не устроило?

Формула массива (ФМ) вводится Ctrl+Shift+Enter
Memento mori
 
Да, собственно?!  8)  (спасибо, JayBhagavan :) )
Изменено: Михаил Лебедев - 09.10.2015 09:14:52
Всё сложное - не нужно. Всё нужное - просто /М. Т. Калашников/
 
Цитата
Михаил Лебедев написал:
Да, собственно?!    (спасибо, JayBhagavan  )
Михаил Лебедев, простите, что-то я туплю, вероятно! Результат вижу. Не нахожу макроса в файле Пример 1 (2)! Укажите, пожалуйста :)
 
Цитата
aesp написал:
Не нахожу макроса в файле
Цитата
Михаил Лебедев написал:
УФ
 
Код
Sub unicolor()
Dim c As Range
Set r = [a2..a9]
r.Interior.Color = xlNone
Set d = CreateObject("scripting.dictionary")
    For Each c In r
    If c.Value > 0 Or Not IsEmpty(c.Value) Then
        If Not d.exists(c.Value) Then
            Set d(c.Value) = c
        Else
            Set d(c.Value) = Union(d(c.Value), c)
        End If
    End If
    Next
Set r = [c2..c8]
r.Interior.Color = xlNone
    For Each c In r
        If d.exists(c.Value) Then
        c.Interior.Color = 65535
        d(c.Value).Interior.Color = 65535
        End If
    Next
End Sub
 
Цитата
V написал:
aesp написал:
Не нахожу макроса в файлеЦитатаМихаил Лебедев написал:
УФ
Да что такое УФ? Я один, наверное, не знаю! )))
 
УФ это не тоже что и ОХ :)
Это "условное форматирование", ищите в меню/помощи/интернетах
 
B.Key, спасибо,
но ещё:
на всю высоту столбца Excelя, чтобы работал и не закрашивал пустые и нули
 
Цитата
aesp написал:
на всю высоту столбца Excelя
может сделать на заполненную?

Цитата
aesp написал:
не закрашивал пустые и нули
Так и работает Исправил
Изменено: B.Key - 09.10.2015 10:55:59
 
Скрытый текст
 
Цитата
B.Key написал:
Исправил
B.Key, уважуха! Всё как хотелось! Благодарю! :D
 
Цитата
Hugo написал:
УФ это не тоже что и ОХ
Это "условное форматирование", ищите в меню/помощи/интернетах
Да в курсе я, что такое "условное форматирование". Задача-то ставилась -уйти от этого УФ, что оказалось, аббревиатурой. Респект решению B.Key,!
 
aesp,простите, если скажу глупость, но Вы PLEX'ом пробовали это сделать? Там же есть "сравнить". Проверил, все сработало. По крайней мере, как в примере.
 
Цитата
AlexTM написал:
Проверил, все сработало.
AlexTM, PLEX сранивает не так тонко, как по моей просьбе это осуществил B.Key, Увидьте разницу!)
Страницы: 1
Наверх