Страницы: 1
RSS
Поиск дубликатов и пустых ячеек в произвольном столбце средствами VBA, Поиск и выделением их цветом. дубликатов и пустых ячеек в произвольном столбце средствами VBA
 
Приветствую уважаемых форумчан!

В столбце планируется серийники - дубликаты и пустые ячейки не допускаются.
Макрос из макрорекордера дубликаты подсвечивает, но на пустые ячейки не реагирует:
Код
Selection.FormatConditions.AddUniqueValues
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    Selection.FormatConditions(1).DupeUnique = xlDuplicate
    With Selection.FormatConditions(1).Font
        .Color = -16383844
        .TintAndShade = 0
    End With
    With Selection.FormatConditions(1).Interior
        .PatternColorIndex = xlAutomatic
        .Color = 13551615
        .TintAndShade = 0
    End With
    Selection.FormatConditions(1).StopIfTrue = False
Изменено: Джек Восмеркин - 09.10.2018 14:45:36
Великий и могучий утес, сверкающий бой, с ногой на небе, живущий, пока не исчезнут машины.
 
Цитата
Джек Восмеркин: Поиск дубликатов и пустых ячеек
файла нет - поэтому ловите VBA (макрос) (для значений <= 255 символов)
xl дома пока отсутствует - тестирование за вами
Код
Sub ПоискПустыхИДублей ()
dim rng as range, cl as range, bad&
set rng=selection

bad=vbred

   for each cl in rng
      if len(cl)=0 or application.worksheetfunction.countif(rng,cl) <>1 then cl.interior.color=bad
   next cl
аргументы функции могут быть другие, я имел ввиду - CountIf ([диапазон], [критерий]) — измените, в случае моей ошибки…
bad - код цвета, меняйте при необходимости, сейчас он "классический" красный и очень неудобный для зрительного восприятия.
Изменено: Jack Famous - 09.10.2018 17:25:58
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
 
Цитата
Джек Восмеркин написал:
Макрос из макрорекордера дубликаты подсвечивает, но на пустые ячейки не реагирует
Например:
Код
Sub Makros1()
    Range("a2").Select
    With Range("a2:e16")
        .FormatConditions.Delete
        .FormatConditions.Add Type:=xlExpression, Formula1:="=A2="""""
        .FormatConditions(1).Interior.ColorIndex = 3
    End With
End Sub

или
Код
Sub Makros2()
    With Range("a2:e16")
        .SpecialCells(xlCellTypeBlanks).Interior.ColorIndex = 3
    End With
End Sub
 
Можно посмотреть здесь и здесь.
«Бритва Оккама» или «Принцип Калашникова»?
 
bedvit, спасибо, очень полезно и познавательно.
Помогло.
Великий и могучий утес, сверкающий бой, с ногой на небе, живущий, пока не исчезнут машины.
Страницы: 1
Наверх