快速删除表格中指定条件的行

yuhaowang

Bod.part1.rar (2 MB, 下载次数: 0)

2019-9-6 17:32 上传

点击文件名下载附件

Bod.part2.rar (1.54 MB, 下载次数: 0)

2019-9-6 17:32 上传

点击文件名下载附件

数据行339415
我用以下代码30分钟都未得

Sub dele()

Sheets("sheet1").Select

Application.ScreenUpdating= False '关闭屏幕刷新

    r= Range("A1048576").End(xlUp).Row

   For i = r To 1 Step -1

       If Cells(i, 3) = "T" Then

           Rows(i).Delete

       End If

Next

Application.ScreenUpdating= True '恢复屏幕刷新

End Sub

请大侠们指教一下。谢谢

我是来讨说法的

快速删除的方法论坛能搜索到，自己搜索吧
提示：主要使用union函数

2E-er

单元格循环太慢 还不如直接搜索删除行

opel-wong

利用Union函数连接起来，一次性删除，提高效率！
代码如下：

1. Sub dele()
   
2.     Dim R As Long, i As Long, Rng As Range
   
3.     Sheets("sheet1").Select
   
4.     Application.ScreenUpdating = False    '关闭屏幕刷新
   
5.     R = Range("A1048576").End(xlUp).Row
   
6.     For i = R To 1 Step -1
   
7.         If Cells(i, 3) = "T" Then
   
8.             If Rng Is Nothing Then Set Rng = Rows(i) Else Set Rng = Union(Rng, Rows(i))
   
9.         End If
   
10.     Next
    
11.     Rng.Delete
    
12.     Application.ScreenUpdating = True    '恢复屏幕刷新
    
13. End Sub

复制代码

Jaofuan

你这应该是个死循环吧，比如 i =16 的时候，把16行删除了，下一行不是16行吗？

yuhaowang

opel-wong 发表于 2019-9-6 16:37
利用Union函数连接起来，一次性删除，提高效率！
代码如下：

运行10分钟一直未响应

opel-wong

yuhaowang 发表于 2019-9-6 16:59
运行10分钟一直未响应

那就把大数据上传，改为数组一次性赋值处理吧，

Jaofuan

1. Sub jaofuan()
   
2. ha = Cells(Rows.Count, 3).End(xlUp).Row
   
3. arr = Sheet1.Range("A1:f" & ha)
   
4. Set Rng = Sheet1.Rows(ha + 1)
   
5. For i = 1 To UBound(arr)
   
6. If arr(i, 3) = "T" Then
   
7. Set Rng = Union(Rng, Sheet1.Rows(i))
   
8.   End If
   
9. Next
   
10. Rng.Delete
    
11. End Sub
    

复制代码

yuhaowang

Jaofuan 发表于 2019-9-6 17:04

也是运行10分钟一直未响应