如果特定列上的单元格是唯一的，则删除行的代码 [英] code to delete the row if the cells on specific column are unique

问题描述

如果C列(Id)中的值是唯一的，我试图创建一个vba代码以完全删除行.因此，在下面的示例中，第6行和第7行将被删除，因为在此列C中111115和111116不会出现多次.欢迎任何帮助！非常感谢.

What I am trying to achieve is to create a vba code to completely delete the rows if the value in column C (Id) is unique. So in example below the rows 6 and 7 would be deleted since the 111115 and 111116 are not showing up more than once in this column C. Any help is welcome! Thanks a lot.

到目前为止的代码:(但尚不可用)

Code so far: (but not working yet)

Sub delete_not_duplicates()

Dim i As Integer, j As Integer, toDel As Boolean, theNum As Integer
i = 2

Do While Cells(i, 3).Value <> ""
    toDel = True
    theNum = Cells(i, 3).Value
    Do While Cells(j, 3).Value <> ""
        If  i <> j and Cells(j, 3) == theNum Then
            toDel = False
    Loop
    If toDel == true Then
       Rows(i).Delete
    Else
    i = i + 1
    End If
Loop


End Sub

推荐答案

以合理的快速方式执行此操作的一般方法是

The general approach to do do this in a reasonable fast way is to

1. 将数据放入变量数组
2. 环绕数组，标识唯一值
3. 为要删除的行建立范围引用，但要延迟删除
4. 循环后，一次性删除所有行

---

Sub demo()
    Dim rDel As Range, rng As Range
    Dim dat As Variant
    Dim i As Long, cnt As Long
    Dim TestCol As Long

    ' Avoid magic numbers
    TestCol = 3 ' Column C

    ' Reference the correct sheet
    With ActiveSheet
        ' Get data range
        Set rng = .Range(.Cells(1, TestCol), .Cells(.Rows.Count, TestCol).End(xlUp))

        ' Get data as a Variant Array to speed things up
        dat = rng.Value

        ' Loop the Variant Array
        For i = 2 To UBound(dat, 1)
            ' Is value unique?
            cnt = Application.CountIfs(rng, dat(i, 1))
            If cnt = 1 Then

                ' If so, add to delete range
                If rDel Is Nothing Then
                    Set rDel = .Cells(i, TestCol)
                Else
                    Set rDel = Union(rDel, .Cells(i, TestCol))
                End If
            End If
        Next
    End With

    ' Do the delete
    If Not rDel Is Nothing Then
        rDel.EntireRow.Delete
    End If
End Sub

这篇关于如果特定列上的单元格是唯一的，则删除行的代码的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！