Excel: выделять дубликаты ячеек в реальном времени - есть ли для этого дополнение?

Question

Я пытаюсь определить дубликаты в Excel.Я могу выделить все дубликаты в столбце, используя стандартные инструменты Excel.

В идеале я хотел бы, скажем, щелкнуть в ячейке A3 и мгновенно выделить все экземпляры в столбце A, которые являются дубликатами A3.Это должно происходить в режиме реального времени.

Answer 1

быстро и грязно, поместите это в нужную область кода листа:

Option Explicit

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Target.Column > 1 Then Exit Sub

    Dim cellsToHighlight As Range, cell As Range
    Set cellsToHighlight = Range("B1")
    For Each cell In Range("A1", Cells(Rows.Count, 1).End(xlUp))
        If cell.Value2 = Target.Value2 Then Set cellsToHighlight = Union(cellsToHighlight, cell)
    Next
    Set cellsToHighlight = Intersect(cellsToHighlight, Columns(1))
    If Not cellsToHighlight Is Nothing Then cellsToHighlight.Select
End Sub

Answer 2

Использовать условное форматирование для «Дублирующих значений»

Answer 3

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

Это должно быть применено клист, который вы используете, и предполагается, что вы оцениваете только столбец A.

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

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

'Name your sheet here
SheetName = "Sheet1"

'Work out how many rows there are in Column A
LastRow = Sheets(SheetName).Cells(Rows.Count, 1).End(xlUp).Row

'Copy current value to check later
CheckValue = Selection.Value


    'Validate there is more than 1 filled cell
    If LastRow > 1 Then

        'Redim an array to hold all Column A data then load it to the array
        ReDim DataArray(1 To LastRow) As Variant
        DataArray = Range(Sheets(SheetName).Cells(1, 1), Sheets(SheetName).Cells(LastRow, 1))

        'Clear previous highlighting
        Range(Sheets(SheetName).Cells(1, 1), Sheets(SheetName).Cells(LastRow, 1)).Interior.Pattern = xlNone

        'loop through array highlighting cells that match the "CheckValue"
        For I = 1 To LastRow

            If DataArray(I, 1) = CheckValue Then

                Sheets(SheetName).Cells(I, 1).Interior.ColorIndex = 4

            End If

        Next I

    End If

End Sub

Вероятно, существует более элегантное решение.