Question

我在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

Excel VBA如何根据列C删除所有重复行

3 个答案: