检查列是否在 VBA-excel 中存在重复记录

Check column if duplicate record exist in VBA-excel

提问by Wilmor Herald

I'm new to VBA Macro in Excel, and would just like to ask if there's any function for checking duplicate records in excel.

我是Excel中VBA宏的新手，想问一下是否有检查excel中重复记录的功能。

This line of code below removes duplicate referring to column A, but I don't want to actually remove it without user's confirmation, what I wanted to do is to ask for user's confirmation if he wants it to be removed or not, like a popup, and then this line would just execute, but I have no idea if there's a function for checking duplicates.

下面的这行代码删除了引用 A 列的重复项，但我不想在没有用户确认的情况下实际删除它，我想要做的是要求用户确认是否要删除它，就像一个弹出窗口，然后这一行就会执行，但我不知道是否有检查重复项的功能。

ActiveSheet.Range("$A:$D").RemoveDuplicates Columns:=1

Thanks in advance for your help.

在此先感谢您的帮助。

采纳答案by tm-

Please try the following code. I've set script to make duplicate cell empty, but you can insert your own code.

请尝试以下代码。我已经设置脚本使重复的单元格为空，但您可以插入自己的代码。

Sub FindDuplicates()

    Dim i As Long
    Dim j As Long
    Dim lDuplicates As Long

    Dim rngCheck As Range
    Dim rngCell As Range
    Dim rngDuplicates() As Range

    '(!!!!!) Set your range
    Set rngCheck = ActiveSheet.Range("$A:$D")

    'Number of duplicates found
    lDuplicates = 0

    'Checking each cell in range
    For Each rngCell In rngCheck.Cells
        Debug.Print rngCell.Address
        'Checking only non empty cells
        If Not IsEmpty(rngCell.Value) Then

            'Resizing and clearing duplicate array
            ReDim rngDuplicates(0 To 0)
            'Setting counter to start
            i = 0

            'Starting search method
            Set rngDuplicates(i) = rngCheck.Find(What:=rngCell.Value, After:=rngCell, LookIn:=xlValues, _
                                                    LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext)

            'Check if we have at least one duplicate
            If rngDuplicates(i).Address <> rngCell.Address Then

                'Counting duplicates
                lDuplicates = lDuplicates + 1

                'If yes, continue filling array
                Do While rngDuplicates(i).Address <> rngCell.Address
                    i = i + 1
                    ReDim Preserve rngDuplicates(0 To i)
                    Set rngDuplicates(i) = rngCheck.FindNext(rngDuplicates(i - 1))
                Loop

                'Ask what to do with each duplicate
                '(except last value, which is our start cell)
                For j = 0 To UBound(rngDuplicates, 1) - 1
                    Select Case MsgBox("Original cell: " & rngCell.Address _
                                       & vbCrLf & "Duplicate cell: " & rngDuplicates(j).Address _
                                       & vbCrLf & "Value: " & rngCell.Value _
                                       & vbCrLf & "" _
                                       & vbCrLf & "Remove duplicate?" _
                                       , vbYesNoCancel Or vbExclamation Or vbDefaultButton1, "Duplicate found")

                        Case vbYes
                            '(!!!!!!!) insert here any actions you want to do with duplicate
                            'Currently it's set to empty cell
                            rngDuplicates(j).Value = ""
                        Case vbCancel
                            'If cancel pressed then exit sub
                            Exit Sub
                    End Select
                Next j
            End If
        End If
    Next rngCell

    'Final message
    Call MsgBox("Total number of duplicates: " & lDuplicates & ".", vbExclamation Or vbDefaultButton1, Application.Name)

End Sub

P.S. If you need to remove dulpicates only inside one column, you need to adjust rngCheck variable to that particular column.

PS 如果您只需要删除一列内的重复项，则需要将 rngCheck 变量调整为该特定列。

P.P.S. In my opinion, it's easier to use conditional formatting.

PPS 在我看来，使用条件格式更容易。