excel 从另一个工作表大范围重复删除

9bfwbjaz  于 2023-01-18  发布在  其他
关注(0)|答案(2)|浏览(139)

目标是删除sheet 1列A中的所有行,如果它们存在于sheet 2列A的列表中。
两列都只包含数字。
工作表1的A列可能包含重复项,如果它们不在工作表2的列表中,这也没关系。
一个选项,我不熟悉,可能会错过是自动筛选。
代码在100到1000的小数据范围内执行,但我有许多书有超过100万条记录需要清理,任何超过10,000条的记录都会使Excel没有响应并无限期冻结。

Sub remDupesfromTwoWs()

With Application 
    .EnableEvents = False 
    CalcMode = .Calculation 
    .Calculation = xlCalculationManual 
    .ScreenUpdating = False 
End With 
 
 ' set range to be searched
 
Dim masterRecordRange As Range ' declare an unallocated array.
Set masterRecordRange = Range("Sheet1!A2:A316730") ' masterRecordRange is now an allocated array
 
 ' store sheet2 column A as searchfor array
 
Dim unwantedRecords() As Variant ' declare an unallocated array.
unwantedRecords = Range("Sheet2!A1:A282393") ' unwantedRecords is now an allocated array
 
 ' foreach masterRecord loop to search masterRecordRange for match in unwantedRecords
Dim i As Double 
Dim delRange As Range 
Set delRange = Range("A" & ActiveSheet.Rows.Count) 
 
 'go through all rows starting at last row
For i = masterRecordRange.Rows.Count To 1 Step -1 
     
     ' loop through unwantedRecords check each offset
    For Each findMe In unwantedRecords 
         
         'If StrComp(cell, findMe, 1) = 0 Then not as fast
         
         ' unwantedRecord found
        If Cells(i, 1).Value = findMe Then 
             
            Set delRange = Union(delRange, Range("A" & i)) 
             
             'MsgBox i
             
            Exit For 
        End If 
    Next findMe 
Next i 
 
 'remove them all in one shot
delRange.EntireRow.Delete 
With Application 
    .EnableEvents = True 
    CalcMode = .Calculation 
    .Calculation = xlCalculationAutomatic 
    .ScreenUpdating = True 
End With 
 'possibly count and display quantity found
MsgBox "finally done!" 
 
End Sub
6qftjkof

6qftjkof1#

一次遍历一个单元格区域非常慢,因为每次调用Cells都会产生很大的开销。因此,您应该将两个区域都放入变量数组中,然后比较它们以构建另一个匹配数组,然后将该数组写回工作表,并使用Autofilter选择要删除的行。以下是一篇关于比较列表的各种方法的博客文章:VBA Comparing lists shootout
最快的方法是使用字典或者集合。你应该能够调整代码来做你想做的事情。

9udxz4iz

9udxz4iz2#

你有没有试过范围.发现:

Sub TestIt()

Dim ws1 As Worksheet, ws2 As Worksheet
Dim LastRow As Long, DestLast As Long, CurRow As Long

Set ws1 = Sheets("Sheet1")
Set ws2 = Sheets("Sheet2")

LastRow = ws1.Range("A" & Rows.Count).End(xlUp).Row
DestLast = ws2.Range("A" & Rows.Count).End(xlUp).Row

For CurRow = LastRow to 2 Step -1 'Must go backwards because you are deleting rows
    If Not ws2.Range("A2:A" & DestLast).Find(ws1.Range("A" & CurRow).Value, LookIn:=xlValues, LookAt:=xlWhole) is Nothing Then
        Range("A" & CurRow).EntireRow.Delete xlShiftUp
    End If
Next CurRow

End Sub

相关问题