Question

所以我一直在研究从我离开的同事那里继承来的宏。问题是，包括主数据在内，创建了超过一百万的空白行。此工作表是从包含30000行的源工作表创建的。

我是VBA菜鸟，所以我一直在逐段阅读代码，以期理解它。在过去的四个小时中，我一直在努力，但没有取得任何进展。我决定制作一个单独的宏，以删除事实之后的空白行。只有一个问题：我必须运行两次宏才能摆脱百万个空白行。

我第一次运行它时，黑色边框（从第一张纸上继承下来）被删除，剩下一百万行无边框。我第二次运行它，留下了最后使用的单元格。我只是不明白发生了什么。这是我一直在使用的代码。

Sub DeleteUnused()


Dim myLastRow As Long
Dim myLastCol As Long
Dim wks As Worksheet
Dim dummyRng As Range


For Each wks In ActiveWorkbook.Worksheets
  With wks
    myLastRow = 0
    myLastCol = 0
    Set dummyRng = .UsedRange
    On Error Resume Next
    myLastRow = _
      .Cells.Find("*", after:=.Cells(1), _
        LookIn:=xlFormulas, lookat:=xlWhole, _
        searchdirection:=xlPrevious, _
        searchorder:=xlByRows).Row
    myLastCol = _
      .Cells.Find("*", after:=.Cells(1), _
        LookIn:=xlFormulas, lookat:=xlWhole, _
        searchdirection:=xlPrevious, _
        searchorder:=xlByColumns).Column
    On Error GoTo 0

    If myLastRow * myLastCol = 0 Then
        .Columns.Delete
    Else
        .Range(.Cells(myLastRow + 1, 1), _
          .Cells(.Rows.Count, 1)).EntireRow.Delete
        .Range(.Cells(1, myLastCol + 1), _
          .Cells(1, .Columns.Count)).EntireColumn.Delete
    End If
  End With
Next wks

End Sub

Answer 1

根据我的评论，这将删除空白行。只需将其作为创建空白行的宏的最后一行即可。

Columns("A").SpecialCells(xlCellTypeBlanks).EntireRow.Delete

Answer 2

这是我用来清理所有空白行和空白列的宏。

您可以决定是否只想删除空行，并保留空列。

Sub Remove_Empty_Rows_And_Columns()

    Dim wks As Worksheet

    Dim row_rng As Range   'All empty rows will be collected here
    Dim col_rng As Range   'All empty columns will be collected here

    Dim last_row As Long    'points to the last row in the used range
    Dim last_column As Long 'points to the last column in the used range

    Dim i As Long           'iterator

    Set wks = ActiveSheet

    With wks

        'finding last row in used range
        last_row = .UsedRange.Rows(.UsedRange.Rows.Count).Row

        'finding last column
        last_column = .UsedRange.Columns(.UsedRange.Columns.Count).Column

        'loop through all rows in the used range and
        'find if current row is blank or not
        For i = 1 To last_row
            If Application.WorksheetFunction.CountA(.Rows(i)) = 0 Then
                'current row is blank..

                If row_rng Is Nothing Then
                    'this is the first blank row. Lets create a new range for it
                    Set row_rng = .Rows(i)
                Else
                    'this is not the first. Let's add it to the previous others
                    Set row_rng = Excel.Union(row_rng, .Rows(i))
                End If
            End If
        Next


        'same logic applies for empty rows
        For i = 1 To last_column
            If Application.WorksheetFunction.CountA(.Columns(i)) = 0 Then
                If col_rng Is Nothing Then
                    Set col_rng = .Columns(i)
                Else
                    Set col_rng = Excel.Union(col_rng, .Columns(i))
                End If
            End If

        Next

    End With


    'lets check if we managed to find any blank rows
    If Not row_rng Is Nothing Then
        row_rng.EntireRow.Delete
    Else
        MsgBox "no rows to delete"
    End If


    'checking if we found any empty columns
    If Not col_rng Is Nothing Then
       col_rng.EntireColumn.Delete
    Else
        MsgBox "no columns to delete"
    End If


End Sub

VBA宏需要运行两次才能从电子表格中删除空白行

2 个答案: