Question

我希望删除包含40-50,000行的数据集中的重复项（保留空白）。我当前的代码将保留第一个和最后一个实例，但我只需保留第一个而删除其余的实例。

Sub dltedups()

Dim toDelete As Range: Set toDelete = Sheet1.Rows(999999) '(to not start with 
a null range)
Dim dict As Object: Set dict = CreateObject("Scripting.Dictionary")
Dim a As Range

For Each a In Sheet1.Range("A7", Sheet1.Range("A999999").End(xlUp))

If Not dict.Exists(a.Value2) Then
  dict(a.Value2) = 0 
Else

  If dict(a.Value2) = 1 Then Set toDelete = Union(toDelete, 
Sheet1.Rows(dict(a.Value2)))
  dict(a.Value2) = a.Row 

End If

Next
toDelete.Delete

End Sub

Answer 1

然后只使用RemoveDuplicates，它将删除除第一个之外的所有内容。

With Sheet1.Range("A7", Sheet1.Range("A999999").End(xlUp))
    .Value = .Value
    .RemoveDuplicates 1,xlno
End with

Answer 2

我明白了。

Dim rng1 As Range
Dim C As Range
Dim objDic
Dim strMsg As String

Set objDic = CreateObject("scripting.dictionary")
Set rng1 = Range([a1], Cells(Rows.Count, "A").End(xlUp))
For Each C In rng1
    If Len(C.Value) > 0 Then
        If Not objDic.Exists(C.Value) Then
            objDic.Add C.Value, 1
        Else
            C.EntireRow.Delete
        End If
    End If
Next

删除重复但保留第一个实例VBA宏

2 个答案: