删除相同数据

xgczwp

数据比较多，求助，根据表2中的数据把表1中相同的一行全部删除。

盼盼198310

............

tanglf188

请测试

1. Sub test6()
   
2.     last = Sheet1.Range("A1").End(xlDown).Row
   
3.     ReDim arr(1 To last - 1, 1 To 3)
   
4.     k = 0
   
5.     For i = 2 To last
   
6.         Set findcell = Sheet2.Range("A:A").Find(Sheet1.Cells(i, "A"), LookAt:=xlWhole)
   
7.         If findcell Is Nothing Then
   
8.             k = k + 1
   
9.             arr(k, 1) = Sheet1.Cells(i, "A")
   
10.             arr(k, 2) = Sheet1.Cells(i, "B")
    
11.             arr(k, 3) = Sheet1.Cells(i, "C")
    
12.         End If
    
13.     Next
    
14.     Sheet1.Range("A2:C" & last).ClearContents
    
15.     Sheet1.Range("A2").Resize(k, 3) = arr
    
16. End Sub

复制代码

sxbjzjf110

tmplinshi

1. Sub DeleteRows()
   
2. 
   
3.     Dim keys As Object, v
   
4.     Set keys = CreateObject("Scripting.Dictionary")
   
5.     For Each v In Sheets("Sheet2").UsedRange.Offset(1).Value
   
6.         keys(v) = ""
   
7.     Next
   
8.    
   
9.     Dim cell As Range
   
10.     Dim delRng As Range
    
11.     Set delRng = Sheets("Sheet1").Cells.SpecialCells(xlCellTypeLastCell).Offset(1)
    
12.     For Each cell In Sheets("Sheet1").UsedRange.Columns("A").Cells
    
13.         If keys.exists(cell.Value) Then
    
14.             Set delRng = Union(delRng, cell)
    
15.         End If
    
16.     Next
    
17. 
    
18.     delRng.EntireRow.Delete
    
19.    
    
20. End Sub

复制代码

xgczwp

sxbjzjf110 发表于 2023-2-10 17:01

表1我有1万条数据，运行后要几分钟。但还是万分感谢

gwjkkkkk

xgczwp 发表于 2023-2-10 19:26
表1我有1万条数据，运行后要几分钟。但还是万分感谢

数组法，速度是否快一些，请测试。。。

sxbjzjf110

用数组重新写了一下代码，这回会快很多。

xgczwp

sxbjzjf110 发表于 2023-2-10 19:59
用数组重新写了一下代码，这回会快很多。

非常感谢，1秒。真快。

xgczwp

也感谢前面所以回复的老师。非常感谢。