刪除重複但保留第一個實例VBA宏

我期待刪除包含40-50,000行的數據集中的重複項（保留空白）。我現在的代碼將保留第一個和最後一個實例，但我只需要保留第一個，而刪除其餘的。刪除重複但保留第一個實例VBA宏

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

來源

2017-05-26 Tom

然後，只要使用RemoveDuplicates，它將刪除除第一個以外的所有。

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

來源

2017-05-26 14:48:40

我得到一個運行時錯誤438 ..也將這是有效的大型數據集50,000+？ – Tom

請參閱編輯，是的它會比循環更快。 –

一切都很好，雖然它也刪除了空白。有沒有辦法消除這種情況？ – Tom

我想通了。

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

來源

2017-05-26 17:13:43 Tom

刪除重複但保留第一個實例VBA宏

回答

相關問題