Excel VBA - 删除空行

Question

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

我找到了这个，但好像无法为自己配置。

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

- CustomX

---

你尝试过用C:C替换A:A吗？ - GSerg

Serg，看来我解释我的问题是错误的。我需要检查整行（A1-Z1）是否为空，并延伸到A50-Z50。 - CustomX

那么，对于您的目的，“整行”是A-Z列，而不是AA...ZZ...吗？ - Brad

是的，对我来说A1到Z1列是整行。如果这些单元格（A1到Z1）中没有任何项目，则该行为空并且可以删除。 - CustomX

Answer 1

你觉得怎么样？

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

- Alex K.

---

还好，只是对我目前的需求来说有点太长了。不过，其他可能遇到同样问题的人会从你的例子中受益的 ;) - CustomX

Answer 2

试试这个

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

如果你想要删除整行数据，请使用以下代码

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

- Siddharth Rout

---

感谢您的努力，不确定它是否有效，但比我接受的片段要长一些。 - CustomX

@Tom：它更长是因为我使用了正确的编码方式，并进行了所有错误处理。无论如何，就这样吧 ;) - Siddharth Rout

哦抱歉 :) 我只需要一个快速修复。虽然感谢您提供详细的示例 :) - CustomX

Answer 3

我知道我来晚了，但这是我写的/使用的一些代码来完成任务。

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

- Smiley Lando

---

给这个人一个该死的奖章。迄今为止最古老和最简单的解决方案。 - srodriguex

如果至少有一个空单元格，将删除整行吗？ - Greencolor

工作得很好！只是要注意合并单元格（这是我在从带有换行符的网格控件中复制/粘贴数据后自动获得的）。对于我来说，由于合并单元格，删除了太多内容。 - Andreas Reiff

Answer 4

我还有一个针对只想删除完全为空的行而不是单个空单元格的情况的解决方案。它也适用于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

- Aranxo

---

可以正常工作，但我建议使用Sub DeleteEmptyRows(Sheet)而不是DeleteEmptyRows(Sheet As Excel.Worksheet)。我使用了DeleteEmptyRows (Workbooks.Open(path).Sheets("sheet1"))。 - Sorry IwontTell

好建议。实际上，我从我的Excel课程中学到了这个，所以Sheet通常是一个类内部的局部变量，而子程序标题只会是Sub DeleteEmptyRows()。为了适应这里，我添加了参数，使其作为独立函数工作。这可能与我们在Excel工作表对象和Sheet对象中有不同的情况相冲突，尽管它们描述的是相同的实体。请随意根据您的需要进行更改。 - Aranxo

Answer 5

对于那些想要删除工作表中的“空白”和“空行”(使用 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
    Next
    ActiveWorkbook.Save
    ActiveWorkbook.Worksheets(1).Activate
End Function

最初的回答：

打开VBA（ALT + F11），插入->模块， 复制并粘贴我的代码，然后按F5启动。 Et voila :D

- jjsteing

Answer 6

这里是基于一列的最快删除所有空行的方法

Dim lstRow as integet, ws as worksheet

Set ws = ThisWorkbook.Sheets("NameOfSheet")

With ws

     lstRow = .Cells(Rows.Count, "B").End(xlUp).Row ' Or Rows.Count "B", "C" or "A" depends 

     .Range("A1:E" & lstRow).SpecialCells(xlCellTypeBlanks).EntireRow.Delete

End with

- Om_VBA

Answer 7

为了使On Error Resume功能工作，您必须将工作簿和工作表值声明为如下所示。

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

我曾经遇到过同样的问题，但是这种方法可以消除所有空行，而无需实现 For 循环。

- Jerome

Answer 8

为了让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

这个内容源自此网站，稍作修改以允许用户选择他们想要从哪张工作表中清除空行。

- RugsKid

Answer 9

这个对我很有用（你可以根据需要调整 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

- user8608712