如果VBA中重复，请删除所有行

Question

>我需要删除所有行而不留下任何唯一记录。如果存在重复项，则删除所有匹配的行。条件为 C 列，如果 C 列中存在任何重复记录，则删除整行(包括唯一(。

下面给定的代码可以工作，但保留唯一行 即使我也不想要这样。

法典：

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

Answer 1

我喜欢

Jeeped的代码，但它不是最好的可读性。因此，这是另一种解决方案。

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

它适用于多个重复项，您可以定义行偏移量，该偏移量定义在列开头忽略的行数。

Answer 2

我喜欢

在没有任何声明变量的情况下尝试这些。将单元格/工作表/工作簿层次结构保持在一起是一种很好的做法。

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

显然，这严重依赖于...结尾为语句。据我估计，这是一种被低估/未充分利用的方法。