Question

我想要实现的是创建一个vba代码，如果C（Id）列中的值是唯一的，则完全删除行。因此，在下面的示例中，第6行和第7行将被删除，因为111115和111116在此列C中未显示多次。欢迎任何帮助！非常感谢。

enter image description here

到目前为止

代码:(但还没有工作）

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

Answer 1

我认为最有效的方式是：

初始化一个空的HashSet＆lt;整数＆GT; （或者你想要的任何泛型类型）代表C（id）的所有唯一条目，让我们将它命名为uniqueIdSet
迭代2D数组



    if(uniqueIdSet.contains(id)){
          //if the id was already seen before, it means it's not unique
          uniqueIdSet.remove(id);
    }
    else{
          //we haven't seen this id yet, add it to the unique set
          uniqueIdSet.add(id);
    }

再次遍历原始数组并执行：



    if(uniqueSet.contains(id)){
          //if the id is unique, remove it from the array.
          array.remove(currentRow);
    }

根据您的实现，您可能无法在迭代时从数组中删除。绕过它的方法是初始化原始数组的副本并从那里删除相应的行。

Answer 2

以合理快速的方式做到这一点的一般方法是

将您的数据导入Variant数组
循环数组，识别唯一值
构建对要删除的行的范围引用，但推迟删除
循环后，一次删除所有行

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

如果特定列上的单元格是唯一的，则删除该行的代码

2 个答案: