0

我想要一个将“表 1 单元格”与“表 2 单元格”进行比较并从表 2 中删除重复项的脚本。我现在正在使用这个脚本

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

但是我的搜索范围遇到了问题，Excel 将工作表行限制在 100 万左右，每个月我的搜索范围都会增加 300k 行，所以很快我就不能使用这个脚本了。我要求任何方法来解决这个限制。

注意： -- 我的目标范围将放在表 2 的 A 列中，并且不会超出限制。-- 脚本应该区分大小写。（ccse3E、cCse3e 不重复）

4

1 回答 1

0

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

于 2013-05-08T15:58:09.697 回答