MS Excel, как создать макрос, чтобы найти дубликаты и выделить их?

Question

Как я могу создать макрос в MS Excel, чтобы найти дубликаты в электронной таблице и выделить его

Answer 1

Может быть, этот фрагмент полезен:

Public Sub MarkDuplicates()
Dim iWarnColor As Integer
Dim rng As Range
Dim rngCell As Variant


Set rng = Range("A1:A200") ' area to check '
iWarnColor = xlThemeColorAccent2

For Each rngCell In rng.Cells
    vVal = rngCell.Text
    If (WorksheetFunction.CountIf(rng, vVal) = 1) Then
        rngCell.Interior.Pattern = xlNone
    Else
        rngCell.Interior.ColorIndex = iWarnColor
    End If
Next rngCell
End Sub

Answer 2

Вам не нужен макрос VBA. Вы можете просто использовать условное форматирование. Microsoft объясняет, как сделать именно то, что вам нужно, здесь:

http://office.microsoft.com/en-us/excel/HA011366161033.aspx

Если вам действительно нужен макрос, самый простой способ - записать шаги, описанные выше, а затем отредактировать при необходимости.

Answer 3

Росс Ларсон ответил на этот вопрос здесь: Поиск дублирующихся строк в Excel

Цитируя его ответ: «Самый быстрый и простой способ. Условное форматирование, выделите дубликаты (в столбце ID). Затем отфильтруйте столбец (предположительно в таблице) по цвету (над флажками)». 1005 *

Вчера я лично попробовал это, и это сработало отлично. Не нужно писать макрос или причудливый скрипт VBA. Просто используйте готовые функции Excel.

В ответе Пола Райнера в 2010 году была сломана ссылка. Ссылка на Росса Ларсона все еще работает - по крайней мере, пока.

Answer 4

Sub Macro1()

    Dim Counter As Integer

    For Counter = 1 To 35

        'Cells.(X,Y) X = number, Y = Letter i.e D5 Cells(5,4)
        firstValue = ActiveSheet.Cells(Counter, 3)
        SecondValue = ActiveSheet.Cells(Counter, 4)

        If firstValue = SecondValue Then
            Rows(Counter).Interior.Color = RGB(255, 10, 10)
        End If


    Next

End Sub

Answer 5

Sub MarkDuplicates2()
Dim rngCell As Variant
Dim flag As Integer

Dim LastRow As Long

'To Check Duplicate records for dynamic rows:
    LastRow = 0
    With ActiveSheet
    LastRow = .Cells(.Rows.Count, "B").End(xlUp).Row
    End With

flag = 0`enter code here`
'Cell(2,2) represent "B2"
Set rng = Range(Cells(2, 2), Cells(LastRow, 2))
iWarnColor = xlThemeColorAccent2

For Each rngCell In rng.Cells
    vVal = rngCell.Text
    If (WorksheetFunction.CountIf(rng, vVal) = 1) Then
        rngCell.Interior.Pattern = xlNone

    Else
        rngCell.Interior.ColorIndex = iWarnColor
        flag = flag + 1
    End If
Next rngCell

    If flag > 0 Then
    MsgBox flag & " cells (in light blue) contain an error.  Please Check!"
    Else
    MsgBox " Data Validation completed. No errors found."
    End If

End Sub