Question

我是Excel中的VBA Macro的新手，并且想询问是否有任何功能可以检查excel中的重复记录。

下面这行代码会删除重复的A栏，但我不想在没有用户确认的情况下将其删除，我想要做的就是要求用户确认如果他想要删除它，就像弹出窗口一样，然后这行就会执行，但我不知道是否有用于检查重复项的功能。

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

提前感谢您的帮助。

Answer 1

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

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

P.S。如果您只需要在一列内删除dulpicates，则需要将rngCheck变量调整到该特定列。

P.P.S。在我看来，使用条件格式更容易。

如果VBA-excel中存在重复记录，请检查列

1 个答案: