Excel VBA如何删除基于C列的所有重复行

我是相当新的Excel VBA中，我想要做的是，删除所有重复的行基于列C中的值，所以每当列C具有重复的值，它将删除整个行。 到目前为止，我有这个

Sub RemoveDupe() Dim rCell As Range Dim rRange As Range Dim lCount As Long Set rRange = Range("C1", Range("C" & Rows.Count).End(xlUp)) lCount = rRange.Rows.Count For lCount = lCount To 1 Step -1 With rRange.Cells(lCount, 1) If WorksheetFunction.CountIf(rRange, .Value) > 1 Then .EntireRow.Delete End If End With Next lCount End Sub 

但在这里它是第一个价值，我想要删除那一个。 只有行将剩下谁没有任何重复或独特的。 任何帮助？

Answer 1

像这样的东西应该为你工作：

 Sub tgr() Dim ws As Worksheet Dim rCheck As Range Dim rDel As Range Set ws = ActiveWorkbook.ActiveSheet For Each rCheck In ws.Range("C1", ws.Cells(ws.Rows.Count, "C").End(xlUp)).Cells If WorksheetFunction.CountIf(ws.Columns("C"), rCheck.Value) > 1 Then If Not rDel Is Nothing Then Set rDel = Union(rDel, rCheck) Else Set rDel = rCheck End If End If Next rCheck If Not rDel Is Nothing Then rDel.EntireRow.Delete End Sub 

Answer 2

 Range("A1:D10").CurrentRegion.RemoveDuplicates Columns:=Array(3), Header:=xlYes 

将删除所选范围内的所有行，并在第三列中显示重复值

Answer 3

稍微不同的方式; 它首先为重复的单元格着色，然后删除每个着色单元格的行。

 Sub test() Dim rng1 As Range Dim lRow As Long Dim i As Long lRow = Range("C" & Rows.Count).End(xlUp).Row Set rng1 = Range("C2", Cells(Rows.Count, "C").End(xlUp)) For Each cell In rng1 If WorksheetFunction.CountIf(rng1, cell.Value) > 1 Then cell.Interior.ColorIndex = 6 End If Next cell For i = lRow To 2 Step -1 If Cells(i, 3).Interior.ColorIndex = 6 Then Rows(i).Delete End If Next End Sub