vba дубликаты / пустые ячейки - PullRequest
0 голосов
/ 08 февраля 2019

Мне нужно создать похожий макрос для дубликатов (см. Ниже).Пользователь сможет выбрать символ столбца, и тогда все дубликаты из выбранного столбца будут выделены цветом.Я не как это сделать.

Ниже та же идея, но с пустыми ячейками.

Не могли бы вы помочь?THX!

Sub EmptyCells()

    Dim kol As String
    Dim ost As Long

    ost = Cells(Rows.Count, "A").End(xlUp).Row
    kol = InputBox("Enter column symbol: B, C...etc.", "Column symbol", "B")

    If kol = vbNullString Then Exit Sub
    If IsNumeric(kol) Then
        MsgBox "You entered number, please enter column symbol", _
                vbInformation, "ERROR"
        Exit Sub
    End If
    If ost < 5 Then Exit Sub

    Range("A5:E" & ost).Interior.Color = xlNone

    Range(Cells(5, kol), Cells(ost, kol)).SpecialCells(xlCellTypeBlanks).Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 65535
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With

End Sub

1 Ответ

0 голосов
/ 08 февраля 2019

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

Sub DuplicateCells() ' changed sub name

    Dim kol As String
    Dim ost As Long

    ost = Cells(Rows.Count, "A").End(xlUp).Row
    kol = InputBox("Enter column symbol: B, C...etc.", "Column symbol", "B")

    If kol = vbNullString Then Exit Sub
    If IsNumeric(kol) Then
        MsgBox "You entered number, please enter column symbol", _
                vbInformation, "ERROR"
        Exit Sub
    End If
    If ost < 5 Then Exit Sub

    Range("A5:E" & ost).Interior.Color = xlNone

    Range(Cells(5, kol), Cells(ost, kol)).Select  ' Remove SpecialCells(xlCellTypeBlanks)
    Selection.FormatConditions.AddUniqueValues   'Add this line
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority      'Add this line
    Selection.FormatConditions(1).DupeUnique = xlDuplicate   'Add this line

    With Selection.FormatConditions(1).Interior   '    add FormatConditions(1)
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 65535
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    Selection.FormatConditions(1).StopIfTrue = False
End Sub

duplicate values highlighted Результаты моих данных показаны.

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...