[分享]删除空行(通用型代码)

彭希仁

Sub 删除空行()
    Dim arr, arr1, arr2
    On Error GoTo ren

    Set d1 = CreateObject("Scripting.Dictionary")
    a = InputBox("使用说明:" & Chr(13) & "一、删除当前表整行为空只需输入数字,如:1或2或3...." & Chr(13) & "二、可同时对多工作表进行删除操作,只需在!号前面加上通配附或字附串,如*!1 或 *月*!1  或  *月!2" & Chr(13) & "三、支持单列或多列为空删除,如：2列和3列为空则删除行 1,2:3 或 *!1,2:3", "删除空行")
    If a = "" Then Exit Sub
        Application.ScreenUpdating = False
    If a Like "*!*" Then
        arr = Split(a, "!")
        arr1 = Split(arr(1), ",")
        If UBound(arr1) = 0 Then
            For i = 1 To 256
                s = d1(i & "a")
            Next i
        Else
            arr2 = Split(arr1(1), ":")
            For i = 0 To UBound(arr2)
                s = d1(arr2(i) & "a")
            Next i
        End If
        For Each sh In Sheets
            If sh.Name Like arr(0) Then
                sh.Select
                Call sckh(arr1(0), d1)
            End If
        Next sh
    Else
        arr = Split(a, ",")
        If UBound(arr) = 1 Then
            arr1 = Split(arr(1), ":")
            For i = 0 To UBound(arr1)
                s = d1(arr1(i) & "a")
            Next i
        Else
            For i = 1 To 256
                s = d1(i & "a")
            Next i
        End If

        Call sckh(arr(0), d1)
    End If
    Application.ScreenUpdating = True
    Exit Sub
ren:
End Sub
Sub sckh(x, d1)
    Dim i As Long
    Dim j As Long
    Dim lng As Long
    Dim lng2 As Long
    On Error GoTo ren
    If x < 0 Then x = 1
    lng = ActiveSheet.UsedRange.Rows.Count
    lng2 = ActiveSheet.UsedRange.Columns.Count
    ReDim arr(1 To lng, 1 To 1)
    rng = Cells(x, 1).Resize(lng, lng2)
    For i = 1 To lng
        For j = 1 To lng2
            If rng(i, j) <> "" And d1.Exists(j & "a") Then
                arr(i, 1) = i
                Exit For
            End If
        Next
    Next
    Cells(x, lng2 + 1).Resize(lng, 1) = arr
    Cells(x, 1).Resize(lng, lng2 + 1).Sort Key1:=Cells(x, lng2 + 1), Order1:=xlAscending
    z = Cells(65536, lng2 + 1).End(xlUp).Row + 1
    Rows(z & ":65536").Delete
    Cells(x, lng2 + 1).Resize(lng, 1) = ""
ren:
End Sub

[此贴子已经被作者于2008-6-24 22:20:41编辑过]

l001011

呵呵  还是彭版厉害  谢谢

fecmen

好东西，麻烦彭版主讲讲思路。o(∩_∩)o...

彭希仁

原理就是生成辅助列,再排序,再一次性删除行.

fecmen

谢谢彭版主讲解！支持！！

yy-128

如果是某单元出现了"0"时,就自动隐藏,怎么办呢?

彭希仁

如果是某单元出现了"0"时,就自动隐藏,怎么办呢

应该不会啊,因为程序没有改单元格内容

yy-128

我想请你帮忙解决,当单元格数值为"0"时,此行就自动隐藏

ml666

学习收藏

张雄友

执行代码，输入1，第9行被删除了。G9：J9 ，不应该有数据。因为IV9有一个1。