Microsoft Excel:
  Таблицы и VBA. Справочник.
  Вопросы и Ответы. Советы. Примеры.
Меню Заметки | Поиск повторяющихся значений(формул) и выделение их цветом

Rambler's Top100


Counter CO.KZ

Предисловие : При работе в MS Excel иногда возникает необходимость в поиске значений, которые встречаются в определённом диапазоне более одного раза, проще говоря, повторяются или являются дублями. И если Вам достаточно просто выделить такие неуникальные значения цветом, то для начала можно протестировать условное форматирование.

Условное форматирование. XL97-2003


Выделите диапазон смежных ячеек, например, A1:C100

В меню Формат выберите команду Условное форматирование, и в поле со списком выберите формула, а в текстовом поле введите следующую формулу :

=СЧЁТЕСЛИ($A$1:$C$100;A1)>1



Теперь, кликните кнопку Формат, установите нужный формат и завершите свои действия нажатием кнопки Ok.





Совет : Если возникнет потребность в выделении уникальных, т.е. неповторяющихся значений, то используйте формулу :

=СЧЁТЕСЛИ($A$1:$C$100;A1)=1

Условное форматирование. XL2007

В этой версии также можно использовать предыдущий вариант, например, если Вас волнует совместимость со старыми версиями Excel. Если же Вы не собираетесь делиться своими наработками с другими, или уверены, что партнеры/коллеги также пользуются аналогичной или более современной версией, то :

Выделите диапазон ячеек (допускается выделение несмежных ячеек)

Выберите закладку Главная, затем команду Условное форматирование, пункт Правила выделения ячеек и команду Повторяющиеся значения.

Теперь, если Вас не устраивает цвет заливки и шрифта, которые предлагаются изначально, просто выберите во втором списке Пользовательский формат. После чего, установите нужный формат и завершите свои действия нажатием кнопки Ok.

Совет : Если возникнет потребность в выделении уникальных, т.е. неповторяющихся значений, то в стандартном диалоговом окне Повторяющиеся значения в поле со списком выберите уникальные





Если же эту задачу необходимо решить программно, т.е. с применением VBA, то можно просто воспользоваться макрорекордером и повторить все действия, перечисленные в любом из вышеопубликованных примеров. Затем, остановить запись макроса и воспользоваться полученным кодом, желательно почистив его от мусора (выделение об'ектов)

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

Вариант I. 
Private Sub Example1()
    Dim iSource As Range, iCell As Range
    Set iSource = [A1:A100,C1:C100]
    
    Application.ScreenUpdating = False
    
    For Each iCell In iSource
        If Not IsEmpty(iCell) Then
           If iCell.Address = iSource.Find(iCell, iCell, xlFormulas, xlWhole).Address Then
              iCell.Interior.Color = vbYellow
           Else
              iCell.Interior.Color = vbRed
           End If
        End If
    Next
    
    Application.ScreenUpdating = True
End Sub
Особенности : Имейте ввиду, что здесь используется поиск формул, а не значений, поэтому, ячейки содержащие, допустим ссылки =B1 и =B2 всегда будут считаться уникальными, даже если ячейки B1 и B2 содержат одно и тоже значение.

Вариант II. 
Private Sub Example2()
    Dim iSource As Range, iCell As Range
    Set iSource = [A1:B100]
    
    Application.ScreenUpdating = False
    
    For Each iCell In iSource
        If Not IsEmpty(iCell) Then
           If Application.CountIf(iSource, iCell) = 1 Then
              iCell.Interior.Color = vbYellow
           Else
              iCell.Interior.Color = vbRed
           End If
        End If
    Next
    
    Application.ScreenUpdating = True
End Sub
Особенности : Этот способ применим только для диапазона смежных ячеек

Вариант III. 
Private Sub Example3()
    Dim iSource As Range, iCell As Range, iRow As Variant
    Set iSource = [A1:A100]
    
    Application.ScreenUpdating = False
    
    For Each iCell In iSource
        iRow = Application.Match(iCell, iSource, 0)
        If Not IsError(iRow) Then
           If iRow = iCell.Row Then
              iCell.Interior.Color = vbYellow
           Else
              iCell.Interior.Color = vbRed
           End If
        End If
    Next
    
    Application.ScreenUpdating = True
End Sub
Особенности : Этот пример предназначен для одного столбца или строки, проще говоря, можно выделить дубли в диапазоне A1:A100 или A1:S1, но нельзя в диапазоне A1:S100


Важно : Для получения таблицы, состоящей из уникальных (неповторяющихся) значений, имеет смысл использовать расширенный фильтр, SQL запрос в т.ч. и с помощью MS Query или метод .RemoveDuplicates об'екта Range (XL2007)



Автор : Климов Павел Юрьевич
© 2004-2016 Климов П.Ю. Все права защищены. WebDesign & Error's Klimoff