如果特定列上的單元格是唯一的，則刪除該行的代碼

Question

如果列 C (Id) 中的值是唯一的，我想要實現的是創建一個 vba 代碼以完全刪除行。 因此，在下面的示例中，第 6 行和第 7 行將被刪除，因為 111115 和 111116 在此列 C 中不會出現多次。歡迎任何幫助！ 非常感謝。

到目前為止的代碼：（但還沒有工作）

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

我認為最有效的方法是：

1. 初始化一個空的 HashSet<Integer>（或任何你想要的泛型類型），它將代表 C（id）的所有唯一條目，讓我們將其命名為 uniqueIdSet

2. 遍歷二維數組

    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);
    }

3. 再次遍歷原始數組並執行：

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

根據您的實現，您可能無法在遍歷數組時從數組中刪除。 一種解決方法是初始化原始數組的副本並從那里刪除相應的行。

Answer 2

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

1. 將數據放入 Variant Array
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