[已解决]批量删除空行

张雄友

批量删除空行，如文件夹《1》下的，《AA》工作簿中，黄色单元的整行空行。 是遍历所有工作簿工作表的！
代码对sheet 1是删除了，但是sheet2删除得不对。

最佳答案

月排行榜 / 总排行榜

dsmch

2015-2-12 08:41

Sub 删除空行()
    Dim sh As Worksheet, w As WorksheetFunction, Filepath, LastRow As Long, NowRow As Long, MyPath$
    With Application.FileDialog(msoFileDialogFolderPicker)
        .InitialFileName = ThisWorkbook.Path & "\"
        If .Show = False Then Exit Sub
        MyPath = .SelectedItems(1) & "\"
    End With
    On Error GoTo 100
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    Set d = CreateObject("scripting.dictionary")
    Set w = Application.WorksheetFunction
    Filepath = GetName(MyPath)
        For kk = 0 To UBound(Filepath)
            Set wb = Workbooks.Open(Filepath(kk))
                For Each sh In wb.Sheets
                    LastRow = sh.UsedRange.Row - 1 + sh.UsedRange.Rows.Count
                    If w.CountA(sh.UsedRange) > 0 Then
                    For NowRow = LastRow To sh.UsedRange(1).Row Step -1
                       If w.CountA(sh.Rows(NowRow)) = 0 Then
                          sh.Rows(NowRow).Delete
                       End If
                    Next NowRow
                End If
            Next
        wb.Close True
    Next
100:
    Application.ScreenUpdating = True
       Application.DisplayAlerts = True
    MsgBox "OK"
End Sub

跳转到最佳答案楼层

dsmch

Sub 删除空行()
    Dim sh As Worksheet, w As WorksheetFunction, Filepath, LastRow As Long, NowRow As Long, MyPath$
    With Application.FileDialog(msoFileDialogFolderPicker)
        .InitialFileName = ThisWorkbook.Path & "\"
        If .Show = False Then Exit Sub
        MyPath = .SelectedItems(1) & "\"
    End With
    On Error GoTo 100
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    Set d = CreateObject("scripting.dictionary")
    Set w = Application.WorksheetFunction
    Filepath = GetName(MyPath)
        For kk = 0 To UBound(Filepath)
            Set wb = Workbooks.Open(Filepath(kk))
                For Each sh In wb.Sheets
                    LastRow = sh.UsedRange.Row - 1 + sh.UsedRange.Rows.Count
                    If w.CountA(sh.UsedRange) > 0 Then
                    For NowRow = LastRow To sh.UsedRange(1).Row Step -1
                       If w.CountA(sh.Rows(NowRow)) = 0 Then
                          sh.Rows(NowRow).Delete
                       End If
                    Next NowRow
                End If
            Next
        wb.Close True
    Next
100:
    Application.ScreenUpdating = True
       Application.DisplayAlerts = True
    MsgBox "OK"
End Sub