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

显然，这严重依赖于With ... End With statement。我估计中被低估/未充分利用的方法。

如果在Excel中重复，则删除所有行 - VBA

2 个答案: