VBA script to compare 2 sheets and delete duplicat

2019-08-30 08:04发布

I want a script that compare "sheet 1 cells" with "sheet 2 Cells" and delete duplicates from sheet 2. I am using now this script

Option Explicit
Sub CleanDupes()
Dim targetArray, searchArray
Dim targetRange As Range
Dim x As Long

'Update these 4 lines if your target and search ranges change
Dim TargetSheetName As String: TargetSheetName = "Sheet2"
Dim TargetSheetColumn As String: TargetSheetColumn = "A"
Dim SearchSheetName As String: SearchSheetName = "Sheet1"
Dim SearchSheetColumn As String: SearchSheetColumn = "A"

'Load target array
With Sheets(TargetSheetName)
    Set targetRange = .Range(.Range(TargetSheetColumn & "1"), _
            .Range(TargetSheetColumn & Rows.Count).End(xlUp))
    targetArray = targetRange
End With
'Load Search Array
With Sheets(SearchSheetName)
    searchArray = .Range(.Range(SearchSheetColumn & "1"), _
            .Range(SearchSheetColumn & Rows.Count).End(xlUp))
End With


Dim dict As Object
Set dict = CreateObject("Scripting.Dictionary")
dict.CompareMode = 0
If IsArray(searchArray) Then
    For x = 1 To UBound(searchArray)
        If Not dict.exists(searchArray(x, 1)) Then
            dict.Add searchArray(x, 1), 1
        End If
    Next
Else
    If Not dict.exists(searchArray) Then
        dict.Add searchArray, 1
    End If
End If

'Delete rows with values found in dictionary
If IsArray(targetArray) Then
    'Step backwards to avoid deleting the wrong rows.
    For x = UBound(targetArray) To 1 Step -1
        If dict.exists(targetArray(x, 1)) Then
            targetRange.Cells(x).EntireRow.Delete
        End If
    Next
Else
    If dict.exists(targetArray) Then
        targetRange.EntireRow.Delete
    End If
End If
End Sub

But I am facing problem with my search range, Excel limits the sheet rows by around 1 million, every month my search range will be increased by 300k row, so soon I can't use this script. I am asking for any method to play around this limitation.

Notes: -- My target range will be placed in sheet 2, column A and will not exceed the limitation. -- The script should be case sensitive. (ccse3E, cCse3e aren't duplicates)

1条回答
Melony?
2楼-- · 2019-08-30 08:29

If you need more than 1 million rows, can I suggest that you consider moving to a database solution. Excel just won't scale.

查看更多
登录 后发表回答