Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
Поиск макросом дубликатов в двух столбцах, Поиск дубликатов в двух столбцах с помощью макроса
 
#1
08.10.2015 19:41:03
Задача на первый взгляд простая: найти дубликаты в двух столбцах, подкрасив одним цветом (например, зелёным) (в примере Лист "Так надо").  
Однако, стандартная фишка "Условное форматирование/Правила выделенных ячеек/Повторяющиеся значения" работает не корректно для моей задачи, поскольку выделяет и те дубли, которые содержатся в одном столбце (в примере Лист "Условное форматирование" цифры 45673). К тому же замечено, что условное форматирование большого количества ячеек в сочетании с Автофильтром - долго очень отрабатывает (Excel "виснет").
Подскажите, пожалуйста, код макроса, решающий эти проблемы, в обход условного форматирования.
Благодарю!
 
 
 
#2
08.10.2015 20:10:25
УФ
Всё сложное - не нужно. Всё нужное - просто /М. Т. Калашников/
 
 
 
#3
08.10.2015 20:22:25
ошибка, надо поправить
Изменено: Evick - 08.10.2015 20:25:43 (ошибочка в файле)
 
 
 
#4
08.10.2015 20:37:30
Если макросом то можно так
Код
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
 
 
 
#5
09.10.2015 08:01:40
Цитата
Evick написал:
ошибка, надо поправить
Да, бы! )
1) нули и пустые не нужно закрашивать;
2) переставлять строки не нужно, а только закрашивать зелёным дубли.
 
 
 
#6
09.10.2015 08:10:43
Цитата
B.Key написал:
Если макросом то можно так
Работает не совсем так, как нужно:
1) выделяет дубли чисел, которые встречаются в одном столбце;
2) при запуске макроса нужно снимать закраску после предыдущего запуска макроса.
 
 
 
#7
09.10.2015 08:34:03
aesp, а чем Вас УФ от уважаемого Михаил Лебедев не устроило?

Формула массива (ФМ) вводится Ctrl+Shift+Enter
Memento mori
 
 
 
#8
09.10.2015 09:14:05
Да, собственно?!  8)  (спасибо, JayBhagavan :) )
Изменено: Михаил Лебедев - 09.10.2015 09:14:52
Всё сложное - не нужно. Всё нужное - просто /М. Т. Калашников/
 
 
 
#9
09.10.2015 10:02:40
Цитата
Михаил Лебедев написал:
Да, собственно?!    (спасибо, JayBhagavan  )
Михаил Лебедев, простите, что-то я туплю, вероятно! Результат вижу. Не нахожу макроса в файле Пример 1 (2)! Укажите, пожалуйста :)
 
 
 
#10
09.10.2015 10:05:29
Цитата
aesp написал:
Не нахожу макроса в файле
Цитата
Михаил Лебедев написал:
УФ
 
 
 
#11
09.10.2015 10:05:53
Код
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
 
 
 
#12
09.10.2015 10:21:12
Цитата
V написал:
aesp написал:
Не нахожу макроса в файлеЦитатаМихаил Лебедев написал:
УФ
Да что такое УФ? Я один, наверное, не знаю! )))
 
 
 
#13
09.10.2015 10:29:24
УФ это не тоже что и ОХ :)
Это "условное форматирование", ищите в меню/помощи/интернетах
 
 
 
#14
09.10.2015 10:36:55
B.Key, спасибо,
но ещё:
на всю высоту столбца Excelя, чтобы работал и не закрашивал пустые и нули
 
 
 
#15
09.10.2015 10:44:04
Цитата
aesp написал:
на всю высоту столбца Excelя
может сделать на заполненную?

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