Delete all rows if duplicate in excel - VBA

问题

I need to remove all rows without leaving any unique record. If duplicate exists delete all matching rows. Criteria is column C if any duplicate record exists in column C then delete entire row (including unique).

Below given code is working but leaving the unique row Even I don't want that.

Code:

Sub DDup()

    Sheets("MobileRecords").Activate
    With ActiveSheet
        Set Rng = Range("A1", Range("C1").End(xlDown))
        Rng.RemoveDuplicates Columns:=Array(3, 3), Header:=xlYes
    End With

End Sub

回答1:

I like the code from Jeeped, but it isn't the best readable one. Therefore, here is another solution.

Sub remDup()
Dim rng As Range, dupRng As Range, lastrow As Long, ws As Worksheet
Dim col As Long, offset As Long, found As Boolean

'Disable all the stuff that is slowing down
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual

'Define your worksheet here
Set ws = Worksheets(1)

'Define your column and row offset here
col = 3
offset = 0

'Find first empty row
Set rng = ws.Cells(offset + 1, col)
lastrow = rng.EntireColumn.Find( _
                What:="", After:=ws.Cells(offset + 1, col)).Row - 1

'Loop through list
While (rng.Row < lastrow)
    Do
        Set dupRng = ws.Range(ws.Cells(rng.Row + 1, col), ws.Cells(lastrow, col)).Find( _
                What:=rng, LookAt:=xlWhole)
        If (Not (dupRng Is Nothing)) Then
            dupRng.EntireRow.Delete
            lastrow = lastrow - 1
            found = True
            If (lastrow = rng.Row) Then Exit Do
        Else
            Exit Do
        End If
    Loop

    Set rng = rng.offset(1, 0)

    'Delete current row
    If (found) Then
        rng.offset(-1, 0).EntireRow.Delete
        lastrow = lastrow - 1
    End If

    found = False
Wend

'Enable stuff again
Application.ScreenUpdating = True
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic

End Sub

It works with more than one duplicate and you can define an row offset, which defines how much rows you ignore at the beginning of the column.

回答2:

I like to try these without any declared variables. It is good practise for keeping your cell / worksheet / workbook hierarchy together.

Sub dupeNuke()
    With Worksheets("Sheet1") '<~~ you should know what worksheet you are supposed to be on
        If .AutoFilterMode Then .AutoFilterMode = False
        With .Cells(1, 1).CurrentRegion
            With .Resize(.Rows.Count - 1, 1).Offset(1, 2)
                With .FormatConditions
                    .Delete
                    .Add Type:=xlExpression, Formula1:="=COUNTIF(C:C, C2)>1"
                End With
                With .FormatConditions(.FormatConditions.Count)
                    .Interior.Color = vbRed
                End With
            End With
            With .Resize(.Rows.Count, 1).Offset(0, 2)
                .AutoFilter Field:=1, Criteria1:=vbRed, Operator:=xlFilterCellColor
                With .Resize(.Rows.Count - 1, .Columns.Count).Offset(1, 0)
                    If CBool(Application.Subtotal(103, Cells)) Then
                        .EntireRow.Delete
                    End If
                End With
            End With
            With .Resize(.Rows.Count - 1, 1).Offset(1, 2)
                With .FormatConditions
                    .Delete
                End With
            End With
        End With
        If .AutoFilterMode Then .AutoFilterMode = False
    End With
End Sub

Obviously, this is heavily reliant on the With ... End With statement. An underrated / underused method in my estimation.

来源：https://stackoverflow.com/questions/35403207/delete-all-rows-if-duplicate-in-excel-vba