[已解决]根据条件删除无效行的问题

Baibdu

附件 删除无效行.rar (539.54 KB, 下载次数: 25)

2014-10-10 10:53 上传

点击文件名下载附件
谢谢老师！

最佳答案

月排行榜 / 总排行榜

grf1973

2014-10-10 11:33

请看附件。用逐行删除是不可取的，要么把所有删除的行union到一个大的Range里一次性删除，要么象我这样全部删除后，把保留下来的一次性写入。

跳转到最佳答案楼层

喜夏1314

1. Sub ts()
   
2. Dim d As Object
   
3. Set d = CreateObject("scripting.dictionary")
   
4. For i = 1 To Sheet2.Range("a1").CurrentRegion.Rows.Count
   
5. d.Add Sheet2.Cells(i, 1).Value, ""
   
6. Next
   
7. For i = Range("a1").End(xlDown).Row To 1 Step -1
   
8. If Not d.exists(Cells(i, 1).Value) Then
   
9. Cells(i, 1).EntireRow.Delete
   
10. End If
    
11. Next
    
12. End Sub

复制代码

zyouong

本末倒置

Baibdu

喜夏1314 发表于 2014-10-10 11:15

谢谢老师帮助。您的作品，能正常运行，但速度超慢。附件里才几万数据就要三五分钟时间，如果是八十万行数据，估计没有几个小时解决不了。

grf1973

1. Sub tt()
   
2.     Dim Flag As Boolean
   
3.     Set d = CreateObject("scripting.dictionary")
   
4.     With Sheet1
   
5.         r = .Cells(.Rows.Count, 1).End(3).Row
   
6.         arr = .Range("a1:e" & r)
   
7.         ReDim xrr(1 To r, 1 To 5)
   
8.         brr = Sheet2.Range("a1:a" & Sheet2.[a65536].End(3).Row)
   
9.         For i = 1 To UBound(brr)
   
10.             d(brr(i, 1)) = ""
    
11.         Next
    
12.         For i = 1 To r
    
13.             x = arr(i, 1)
    
14.             If d.exists(x) Then
    
15.                 n = n + 1
    
16.                 For j = 1 To 5: xrr(n, j) = arr(i, j): Next
    
17.             End If
    
18.         Next
    
19.         .Columns("a:e").ClearContents
    
20.         If n > 0 Then .[a1].Resize(n, 5) = xrr
    
21.     End With
    
22. End Sub
    

复制代码

grf1973

请看附件。用逐行删除是不可取的，要么把所有删除的行union到一个大的Range里一次性删除，要么象我这样全部删除后，把保留下来的一次性写入。

grf1973

用一次性删除行的代码。。。。。。速度比生成要慢。

1. Sub ts()
   
2.     Dim DelRng As Range
   
3.      Set d = CreateObject("scripting.dictionary")
   
4.     With Sheet1
   
5.         r = .Cells(.Rows.Count, 1).End(3).Row
   
6.         arr = .Range("a1:e" & r)
   
7.         Set DelRng = .Rows(.Rows.Count)
   
8.         ReDim xrr(1 To r, 1 To 5)
   
9.         brr = Sheet2.Range("a1:a" & Sheet2.[a65536].End(3).Row)
   
10.         For i = 1 To UBound(brr)
    
11.             d(brr(i, 1)) = ""
    
12.         Next
    
13.         For i = 1 To r
    
14.             If Not d.exists(arr(i, 1)) Then Set DelRng = Union(DelRng, .Rows(i))
    
15.         Next
    
16.         DelRng.Delete
    
17.     End With
    
18. End Sub

复制代码

grf1973

两种方法都作了按钮，可以比较一下。

喜夏1314

Baibdu 发表于 2014-10-10 11:25
谢谢老师帮助。您的作品，能正常运行，但速度超慢。附件里才几万数据就要三五分钟时间，如果是八十万行数 ...

几万的数据不放在数据库里面，搞在excel里面不是自找难处！{:101:}