logo标签列表

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

excelvba
3

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

下面这行代码可以删除A列中的重复记录，但我不想在用户确认之前就直接删除它，我希望询问用户是否要删除，类似于弹出窗口，然后这行代码会执行，但我不知道是否有检查重复项的函数。

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

Thanks in advance for your help.

您可以使用条件格式设置来突出显示重复项，并选择删除不需要的重复项。 - Paresh J
我认为条件格式不是解决这个问题的合适方法。如果有任何方法可以检查（只是检查）列中是否存在重复项，那就太好了。 - Synectouche
http://www.wikihow.com/Find-Duplicates-in-Excel 还有一些非编程技巧。 - barryleajo
但我希望它在代码中。实际上，我有一个按钮，当点击时，会告知用户是否存在重复项，以及用户是否想要删除它。 - Synectouche
1个回答
3

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

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$1:$D$38")

    '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

附注：如果您只需要在一个列中删除重复项，则需要将rngCheck变量调整到该特定列。

顺便说一句，我认为使用条件格式更容易。

非常感谢您。 :) - Synectouche
网页内容由stack overflow 提供, 点击上面的
可以查看英文原文，
原文链接