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

【问题标题】：Deleting duplicates but keeping first instance VBA Macro删除重复项但保留第一个实例 VBA 宏
【发布时间】：2017-10-27 12:20:58
【问题描述】：

我希望删除包含 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

【问题讨论】：

标签： vba excel duplicates

【解决方案1】：

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

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

【讨论】：

我得到一个运行时错误 438.. 这对于 50,000+ 的大型数据集也有效吗？
一切都很好，虽然它也删除了空白。有没有办法消除它？
不，您的问题中没有指定。你又回到了迭代和字典。

【解决方案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

【讨论】：