[已解决]如何快速删除含有“长时间”的行

我不知道呀

Sub 删除()
t = Timer
    Dim r As Long
    Dim i As Long
    r = Sheet1.UsedRange.Rows.Count
    For i = r To 1 Step -1
        If Cells(i, 1).Find("*", , xlValues, , , 2) Like "*长时间*" Then
            Rows(i).Delete
        End If
    Next
    MsgBox Timer - t
End Sub
这段代码，对A列的含有长时间的行进行删除，运行时间太长，请大家帮忙，如何提速！谢谢！！

最佳答案

月排行榜 / 总排行榜

liuts

2011-6-30 19:47

1. Sub DelBlankRow()
   
2. On Error Resume Next
   
3. t = Timer
   
4.     Dim i As Long
   
5.     Dim arr
   
6.     arr = Sheet1.UsedRange
   
7.     For i = 1 To UBound(arr)
   
8.         If arr(i, 1) Like "*长时间*" Then
   
9.             arr(i, 1) = ""
   
10.         End If
    
11.     Next
    
12.     Range("A1").Resize(UBound(arr), 1) = arr
    
13.     Sheet1.Columns("A:A").SpecialCells(xlCellTypeBlanks).Select
    
14.     Selection.EntireRow.Delete
    
15.     MsgBox Timer - t
    
16. End Sub

复制代码

跳转到最佳答案楼层

砂海

Application.ScreenUpdating = flase （关闭屏幕更新）

程序结束前
Application.ScreenUpdating = True （开启屏幕更新）
其他技巧暂不会

砂海

另外long的范围 -2147483648 ~ 2147483647
是否大了点？

Interger 范围 -32768 ~ 32767

我不知道呀

回复 砂海 的帖子

这个我知道的，不会快多少，谢谢你的答复！

我不知道呀

回复 砂海 的帖子

我的数据范围需要用到long，因为数据量很大

砂海

16、提高字符串操作的性能
(1)尽可能少使用连接操作。可以在等号左边使用Mid函数替换字符串中的字符，而不是将它们连接在一起。使用 Mid 函数的缺点是替换字符串必须与要替换的子字符串的长度相同。例如，
Dim strText As String
strText = "this is a test"
Mid(strText, 11, 4) = "tent"
(2)VBA提供许多可用来替换函数调用的内部字符串常量。例如，可以使用vbCrLf常量来表示字符串中的回车/换行组合，而不是使用Chr(13) & Chr(10)。
(3)字符串比较操作的执行速度很慢。有时，可以通过将字符串中的字符转换为 ANSI 值来避免这些操作。例如，下列代码会检查字符串中的第一个字符是否为空格：
If Asc(strText) = 32 Then
上面的代码会比以下代码更快：
If Left(strText, 1) = " " Then
17、使用Asc()检验ANSI的值
在VBA 中，可以使用Chr$()函数把数转换成字符，并确定ANSI的值，但是更好的是使用Asc()函数把字符串转换成数值，然后确定它的ANSI值。如果需要进行有限次数的这种检验，对程序代码的效率可能不会产生很大影响，但是，如果需要在多个循环内进行这种检验时，这将节省处理时间并且有助于程序代码更快地执行。

liuts

1. Sub DelBlankRow()
   
2. On Error Resume Next
   
3. t = Timer
   
4.     Dim i As Long
   
5.     Dim arr
   
6.     arr = Sheet1.UsedRange
   
7.     For i = 1 To UBound(arr)
   
8.         If arr(i, 1) Like "*长时间*" Then
   
9.             arr(i, 1) = ""
   
10.         End If
    
11.     Next
    
12.     Range("A1").Resize(UBound(arr), 1) = arr
    
13.     Sheet1.Columns("A:A").SpecialCells(xlCellTypeBlanks).Select
    
14.     Selection.EntireRow.Delete
    
15.     MsgBox Timer - t
    
16. End Sub

复制代码

我不知道呀

回复 liuts 的帖子

数组加特殊定位删除，学习了，谢谢！！

Zipall

用自动筛选加定位可见单元格应该更快一点吧?

我不知道呀

回复 Zipall 的帖子

又学一招，谢谢你。我在网页上复制大量数据到EXCEL中，然后对表格进行筛选，有时会发现连自动筛选也变得好慢，所以我想到用VBA来解决。不知道为什么对网页上数据复制过来后，连自动筛选也慢了，要等很长时间。