Excel VBA - 删除空行

Excel VBA - Delete empty rows

提问by CustomX

I would like to delete the empty rows my ERP Quotation generates. I'm trying to go through the document (A1:Z50) and for each row where there is no data in the cells (A1-B1...Z1 = empty, A5-B5...Z5 = empty) I want to delete them.

我想删除我的 ERP 报价单生成的空行。我正在尝试浏览文档 ( A1:Z50) 并且对于单元格 ( A1-B1...Z1 = empty, A5-B5...Z5 = empty) 中没有数据的每一行，我想删除它们。

I found this, but can't seem to configure it for me.

我找到了这个，但似乎无法为我配置它。

On Error Resume Next
Worksheet.Columns("A:A").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
On Error GoTo 0

回答by Alex K.

How about

怎么样

sub foo()
  dim r As Range, rows As Long, i As Long
  Set r = ActiveSheet.Range("A1:Z50")
  rows = r.rows.Count
  For i = rows To 1 Step (-1)
    If WorksheetFunction.CountA(r.rows(i)) = 0 Then r.rows(i).Delete
  Next
End Sub

回答by Siddharth Rout

Try this

尝试这个

Option Explicit

Sub Sample()
    Dim i As Long
    Dim DelRange As Range

    On Error GoTo Whoa

    Application.ScreenUpdating = False

    For i = 1 To 50
        If Application.WorksheetFunction.CountA(Range("A" & i & ":" & "Z" & i)) = 0 Then
            If DelRange Is Nothing Then
                Set DelRange = Range("A" & i & ":" & "Z" & i)
            Else
                Set DelRange = Union(DelRange, Range("A" & i & ":" & "Z" & i))
            End If
        End If
    Next i

    If Not DelRange Is Nothing Then DelRange.Delete shift:=xlUp
LetsContinue:
    Application.ScreenUpdating = True

    Exit Sub
Whoa:
    MsgBox Err.Description
    Resume LetsContinue
End Sub

IF you want to delete the entire row then use this code

如果要删除整行，请使用此代码

Option Explicit

Sub Sample()
    Dim i As Long
    Dim DelRange As Range

    On Error GoTo Whoa

    Application.ScreenUpdating = False

    For i = 1 To 50
        If Application.WorksheetFunction.CountA(Range("A" & i & ":" & "Z" & i)) = 0 Then
            If DelRange Is Nothing Then
                Set DelRange = Rows(i)
            Else
                Set DelRange = Union(DelRange, Rows(i))
            End If
        End If
    Next i

    If Not DelRange Is Nothing Then DelRange.Delete shift:=xlUp
LetsContinue:
    Application.ScreenUpdating = True

    Exit Sub
Whoa:
    MsgBox Err.Description
    Resume LetsContinue
End Sub

回答by Smiley Lando

I know I am late to the party, but here is some code I wrote/use to do the job.

我知道我参加聚会迟到了，但这是我编写/使用的一些代码来完成这项工作。

Sub DeleteERows()
    Sheets("Sheet1").Select
    Range("a2:A15000").Select
    Selection.SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End Sub

回答by jjsteing

for those who are intersted to remove "empty" and "blank" rows ( Ctrl + Shift + End going deep down of your worksheet ) .. here is my code. It will find the last "real"row in each sheet and delete the remaining blank rows.

对于那些有兴趣删除“空”和“空白”行的人（Ctrl + Shift + End 深入工作表）..这是我的代码。它将在每个工作表中找到最后一个“真实”行并删除剩余的空白行。

Function XLBlank()
    For Each sh In ActiveWorkbook.Worksheets
        sh.Activate
        Cells(1, 1).Select
        lRow = Cells.Find(What:="*", _
            After:=Range("A1"), _
            LookAt:=xlPart, _
            LookIn:=xlFormulas, _
            SearchOrder:=xlByRows, _
            SearchDirection:=xlPrevious, _
            MatchCase:=False).Row

        Range("A" & lRow + 1, Range("A1").SpecialCells(xlCellTypeLastCell).Address).Select
        On Error Resume Next
        Selection.EntireRow.SpecialCells(xlBlanks).EntireRow.Delete
        Cells(1, 1).Select
        ActiveWorkbook.Save
    Next
    ActiveWorkbook.Worksheets(1).Activate
    ActiveWorkbook.Save
End Function

Open VBA ( ALT + F11 ), Insert -> Module, Copy past my code and launch it with F5. Et voila :D

打开 VBA ( ALT + F11 )，插入 -> 模块，复制过去我的代码并使用 F5 启动它。等等 :D

回答by Aranxo

I have another one for the case when you want to delete only rows which are complete empty, but not single empty cells. It also works outside of Excel e.g. on accessing Excel by Access-VBA or VB6.

当您只想删除完全为空的行而不是单个空单元格时，我还有另一种情况。它也可以在 Excel 之外使用，例如通过 Access-VBA 或 VB6 访问 Excel。

Public Sub DeleteEmptyRows(Sheet As Excel.Worksheet)
    Dim Row As Range
    Dim Index As Long
    Dim Count As Long

    If Sheet Is Nothing Then Exit Sub

    ' We are iterating across a collection where we delete elements on the way.
    ' So its safe to iterate from the end to the beginning to avoid index confusion.
    For Index = Sheet.UsedRange.Rows.Count To 1 Step -1
        Set Row = Sheet.UsedRange.Rows(Index)

        ' This construct is necessary because SpecialCells(xlCellTypeBlanks)
        ' always throws runtime errors if it doesn't find any empty cell.
        Count = 0
        On Error Resume Next
        Count = Row.SpecialCells(xlCellTypeBlanks).Count
        On Error GoTo 0

        If Count = Row.Cells.Count Then Row.Delete xlUp
    Next
End Sub

回答by RugsKid

To make Alex K's answer slightly more dynamic you could use the code below:

为了使 Alex K 的回答更加动态，您可以使用以下代码：

Sub DeleteBlankRows()

Dim wks As Worksheet
Dim lngLastRow As Long, lngLastCol As Long, lngIdx As Long, _
    lngColCounter As Long
Dim blnAllBlank As Boolean
Dim UserInputSheet As String

UserInputSheet = Application.InputBox("Enter the name of the sheet which you wish to remove empty rows from")

Set wks = Worksheets(UserInputSheet)

With wks
    'Now that our sheet is defined, we'll find the last row and last column
    lngLastRow = .Cells.Find(What:="*", LookIn:=xlFormulas, _
                             SearchOrder:=xlByRows, _
                             SearchDirection:=xlPrevious).Row
    lngLastCol = .Cells.Find(What:="*", LookIn:=xlFormulas, _
                             SearchOrder:=xlByColumns, _
                             SearchDirection:=xlPrevious).Column

    'Since we need to delete rows, we start from the bottom and move up
    For lngIdx = lngLastRow To 1 Step -1

        'Start by setting a flag to immediately stop checking
        'if a cell is NOT blank and initializing the column counter
        blnAllBlank = True
        lngColCounter = 2

        'Check cells from left to right while the flag is True
        'and the we are within the farthest-right column
        While blnAllBlank And lngColCounter <= lngLastCol

            'If the cell is NOT blank, trip the flag and exit the loop
            If .Cells(lngIdx, lngColCounter) <> "" Then
                blnAllBlank = False
            Else
                lngColCounter = lngColCounter + 1
            End If

        Wend

        'Delete the row if the blnBlank variable is True
        If blnAllBlank Then
            .rows(lngIdx).delete
        End If

    Next lngIdx
End With


MsgBox "Blank rows have been deleted."

 End Sub

This was sourced from this websiteand then slightly adapted to allow the user to choose which worksheet they want to empty rows removed from.

这是来自这个网站，然后稍微调整以允许用户选择他们想要清空从哪个工作表中删除的行。

回答by RugsKid

This worked great for me (you can adjust lastrow and lastcol as needed):

这对我很有用（您可以根据需要调整 lastrow 和 lastcol）：

Sub delete_rows_blank2()

t = 1
lastrow = ActiveSheet.UsedRange.Rows.Count
lastcol = ActiveSheet.UsedRange.Columns.Count

Do Until t = lastrow

For j = 1 To lastcol
    'This only checks the first column because the "Else" statement below will skip to the next row if the first column has content.
    If Cells(t, j) = "" Then

        j = j + 1

            If j = lastcol Then
            Rows(t).Delete
            t = t + 1
            End If

    Else
    'Note that doing this row skip, may prevent user from checking other columns for blanks.
        t = t + 1

    End If

Next

Loop

End Sub

回答by Jerome

In order to have the On Error Resume function work you must declare the workbook and worksheet values as such

为了使 On Error Resume 函数工作，您必须声明工作簿和工作表值

On Error Resume Next  
ActiveWorkbook.Worksheets("Sheet Name").Columns("A:A").SpecialCells(xlCellTypeBlanks).EntireRow.Delete  
On Error GoTo 0

I had the same issue and this eliminated all the empty rows without the need to implement a For loop.

我遇到了同样的问题，这消除了所有空行，而无需实现 For 循环。