Question

我想要一个脚本将“工作表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不重复）

Answer 1

如果您需要超过100万行，我是否可以建议您考虑转移到数据库解决方案。 Excel不会扩展。

VBA脚本比较2张并删除重复的单元格“Big Search Range”

1 个答案: