[讨论]如何"高效"的删除空白行

xiangchendub

[em09][em09]

ve710b

用自定义查找定位 ctrl+G,选定空值，然后删除，单元格上移。

这个方法最快。

YoSQL

定位方式有限制

extyg

Sub test()
    Dim arr1, arr(1 To 60000, 1 To 10), i, j, k
    arr1 = [a1:j60000]
    For i = 1 To 60000
        If Application.WorksheetFunction.CountA(Rows(i)) <> 0 Then
            k = k + 1
            For j = 1 To 10
                arr(k, j) = arr1(i, j)
            Next
        End If
    Next
    [a1:j60000] = arr
    Erase arr
    Erase arr1
End Sub

crozy

为了保存格式,试了两种方法

第一种方法,筛选:91秒

Sub aa()
t1 = Timer
Application.ScreenUpdating = False
    Columns("A:A").Insert Shift:=xlToRight
    Rows("1:1").Insert Shift:=xlDown
    [a1:k1] = "A"
    [a2:a60001] = "B"
    [b1].AutoFilter Field:=2, Criteria1:="="
    [c1].AutoFilter Field:=3, Criteria1:="="
    [d1].AutoFilter Field:=4, Criteria1:="="
    [e1].AutoFilter Field:=5, Criteria1:="="
    [f1].AutoFilter Field:=6, Criteria1:="="
    [g1].AutoFilter Field:=7, Criteria1:="="
    [h1].AutoFilter Field:=8, Criteria1:="="
    [i1].AutoFilter Field:=9, Criteria1:="="
    [j1].AutoFilter Field:=10, Criteria1:="="
    [k1].AutoFilter Field:=11, Criteria1:="="
    Rows("2:60000").Delete Shift:=xlUp
    Selection.AutoFilter
    Rows("1:1").Delete Shift:=xlUp
    Columns("A:A").Delete Shift:=xlToLeft
Application.ScreenUpdating = True
MsgBox Timer - t1
End Sub

第二种方法,循环每20条删一次,90秒------基本二种方法一样时间

Sub aa()
t1 = Timer
Application.ScreenUpdating = False
    Dim rng, k
    Dim str, str2 As String
    rng = [A1:J60000]
    For i = 60000 To 1 Step -1
        If rng(i, 1) & rng(i, 2) & rng(i, 3) & rng(i, 4) & rng(i, 5) & rng(i, 6) & rng(i, 7) & rng(i, 8) & rng(i, 9) & rng(i, 10) = "" Then
            str = str & i & ":" & i & ","
            k = k + 1
            If k = 20 Then
                str2 = Left(str, Len(str) - 1)
                Range(str2).Delete Shift:=xlUp
                k = 0
                str = ""
            End If
        End If
    Next
Application.ScreenUpdating = True
MsgBox Timer - t1
End Sub

彭希仁

还是慢了

YoSQL

用筛选方式，如果没排序，速度就跟不上了

magicqiang

关注一下

crozy

哈哈,最佳方案出炉:不用1秒

见后面

[此贴子已经被作者于2008-5-10 17:38:54编辑过]

crozy

最佳方案之代码优化:

Sub aa()
t1 = Timer
Application.ScreenUpdating = False
    Dim rng, arr(1 To 60000, 1 To 1), k
    rng = [a1:j60000]
    For i = 1 To 60000
        If rng(i, 1) & rng(i, 2) & rng(i, 3) & rng(i, 4) & rng(i, 5) & rng(i, 6) & rng(i, 7) & rng(i, 8) _
        & rng(i, 9) & rng(i, 10) <> "" Then k = k + 1: arr(i, 1) = k
    Next
    [k1:k60000] = arr
    [a1:k60000].Sort Key1:=Range("k1"), Order1:=xlAscending
    [k1:k60000] = ""
Application.ScreenUpdating = True
MsgBox Timer - t1
End Sub

[此贴子已经被作者于2008-5-10 17:36:01编辑过]