删除重复，如果他们在一起excell专栏

我试图删除整个行，如果重复被发现在一起。 如果没有find，我想保留它而不删除。

For an example Column A: Apple, Apple, Orange, Orange, Apple, Apple, 

我需要输出为;

 Apple, Orange, Apple, 

我正在使用下面的代码，但尚未达到所需的输出（只得到苹果，橙色）。 任何帮助表示赞赏，谢谢。

  Sub FindDuplicates() Dim LastRow, matchFoundIndex, iCntr As Long LastRow = Cells(Rows.Count, "A").End(xlUp).Row For iCntr = 1 To LastRow If Cells(iCntr, 1) <> "" Then matchFoundIndex = WorksheetFunction.Match(Cells(iCntr, 1), Range("A1:A" & LastRow), 0) If iCntr <> matchFoundIndex Then Cells(iCntr, 10) = "Duplicate" End If End If Next last = Cells(Rows.Count, "J").End(xlUp).Row ' check results col for values For i = last To 2 Step -1 If (Cells(i, "J").Value) = "" Then Else Cells(i, "J").EntireRow.Delete ' if values then delete End If Next i End Sub 

Answer 1

不是像简单的东西

 Dim LastRow As Long Application.screenUpdating=False LastRow = Cells(Rows.Count, "A").End(xlUp).Row For i = LastRow To 2 Step -1 If Cells(i, 1).Value = Cells(i - 1, 1).Value Then Cells(i, 1).EntireRow.Delete End If Next i Application.screenUpdating=True 

解决这个？

Answer 2

从下往上工作，只有在上面的单元格是相同的值时才删除。

 dim r as long with worksheets("sheet1") for r = .cells(.rows.count, "A").end(xlup).row to 2 step -1 if lcase(.cells(r, "A").value2) = lcase(.cells(r - 1, "A").value2) then .rows(r).entirerow.delete end if next r end with 

如果您不希望比较是不区分大小写的，则删除lcase函数。