|
Предисловие :
При работе в 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
|