删除所有行，如果在excel - VBA中重复 [英] Delete all rows if duplicate in excel - VBA

问题描述

我需要删除所有的行，而不会留下任何唯一的记录。如果存在重复删除所有匹配的行。条件是列C，如果列C中存在任何重复记录，然后删除整行（包括唯一）。

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.

代码：

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

推荐答案

我喜欢Jeeped的代码，但它不是最好的可读的。因此，这里是另一个解决方案。

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.

这篇关于删除所有行，如果在excel - VBA中重复的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！