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

43379677

Sub bb()
    t1 = Timer
    Application.ScreenUpdating = False
    Dim rng, arr(1 To 60000, 1 To 1), k
    rng = [a1:j60000]
    For i = 1 To 60000
        For j = 1 To 10
            If rng(i, j) <> "" Then
                arr(i, 1) = i
                Exit For
            End If
        Next
    Next
    [k1:k60000] = arr
    [a1:k60000].Sort Key1:=Range("k1"), Order1:=xlAscending
    [k1:k60000] = ""
    Application.ScreenUpdating = True
    MsgBox Timer - t1
End Sub

还可以再优化些

crozy

应该算最完美的了。

lj1226189

楼上两位想法非常好!精妙!不知彭版主是否有惊人之作,期待!

crozy

哈哈,用if方式更快啦！

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

彭希仁

QUOTE:

以下是引用crozy在2008-5-11 13:26:50的发言：

哈哈,用if方式更快啦！

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

非常不错,如果能适用行数和列数不固定就更完美了

[此贴子已经被作者于2008-5-12 8:24:42编辑过]

andysky

QUOTE:

以下是引用彭希仁在2008-5-12 8:22:44的发言：

非常不错,如果能适用行数和列数不固定就更完美了

可以啊

稍加修改就行了，仍然可以3秒钟之内完成6万行（或者不定行），不定列的删除空值。

补充：３秒钟是保守的估计，电脑好一点一般是１秒钟左右完成．

改用以下结构：

    lng = ActiveSheet.UsedRange.Rows.Count
    lng2 = ActiveSheet.UsedRange.Columns.Count
    ReDim arr(1 To lng, 1 To 1)

[此贴子已经被作者于2008-5-12 12:45:54编辑过]

lj1226189

因为要判断每一行各列是否空!

彭希仁

QUOTE:

以下是引用andysky在2008-5-12 9:56:19的发言：

可以啊

稍加修改就行了，仍然可以3秒钟之内完成6000行（或者不行定），不定位列的删除空值。

罗兄,你有两个马甲?

lj1226189

估计30秒完成也是不可能的!

masher

回26楼,

可以用 UsedRange 来限定起始和结束的行列。