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

我需要删除所有行而不留下任何唯一logging。 如果重复，则删除所有匹配的行。 如果列C中存在任何重复logging，则条件是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的代码，但它不是最好的可读代码。 因此，这是另一个解决scheme。

 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 

它可以处理多个副本，并且可以定义一个行偏移量，该行偏移量定义在列的开始处您忽略了多less行。

Answer 2

我喜欢尝试这些没有任何声明的variables。 保持您的单元格/工作表/工作簿层次结构是一个很好的做法。

 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语句 。 根据我的估计，这是一个被低估/使用不足的方法