☰

用于删除空行的 Excel 宏不会停止

tag-icon • tag-icon microsoft-excel macros vba
用于删除空行的 Excel 宏不会停止

如何让它在一定行数之后停止？

我上过 VBA 课程，老师讲解了如何删除空行。我现在正尝试执行此操作，但我的宏没有停止。我以为我已将其限制为 200 行。

我遗漏了一些重要的东西。任何指点都非常感谢。

Sub RemoveRows()
' Remove rows from last blank cell

Dim LastRow As Long
Dim ISEmpty As Long

'Count how many records in the list. This is done so that the Do loop has a finish point.
LastRow = Range("A200").End(xlUp).Row

'Start at the top of the list
Range("A1").Select

'Loop until the end of the list
Do While ActiveCell.Row < LastRow

'Assign number of non empty cells in the row
    ISEmpty = Application.CountA(ActiveCell.EntireRow)

'If ISEmpty = 0 then delete the row, if not move down a cell into the next row
        If ISEmpty = 0 Then
            ActiveCell.EntireRow.Delete
        Else
            ActiveCell.Offset(1, 0).Select
        End If

Loop

End Sub

答案1

'从列表顶部开始

这就是问题所在。删除行时，始终从列表末尾开始，以避免无限循环。

逐步执行代码。它将删除已填充单元格上方的空行，然后逐步选择已填充单元格。之后，它将选择已填充单元格下方的空单元格并删除该行。

例如，如果该行是第 35 行，那么第 35 行将被删除。但下面的行将上移一位，因此您实际上从未删除过第 35 行。删除后，所选内容仍位于第 35 行。因此，您陷入了无限循环。

从下往上构建循环。

Option Explicit

Sub RemoveRows()
' Remove rows from last blank cell

Dim LastRow As Long
Dim ISEmpty As Long
Dim i As Long

'Count how many records in the list. This is done so that the Do loop has a finish point.
LastRow = Range("A200").End(xlUp).Row

'Start at the top of the list
For i = LastRow To 1 Step -1

'Assign number of non empty cells in the row
    ISEmpty = Application.CountA(Range("A" & i).EntireRow)

'If ISEmpty = 0 then delete the row, if not move up a cell into the previous row
        If ISEmpty = 0 Then
            Range("A" & i).EntireRow.Delete
        End If
Next i

End Sub

这也许可以用一种更优雅的方式来完成，但希望它能给你一个开始。

答案2

正如上述用户所说，此代码更优雅。但如果代码量超过 800 行，出于某种原因，它会占用大量内存。

Sub RemoveEmptyRows()
On Error Resume Next
    With ActiveSheet.Range(Cells(2, 1), Cells(Rows.Count, 1))
    .Value = .Value
    .SpecialCells(xlCellTypeBlanks).Delete Shift:=xlUp
    End With
End Sub

再经过一次，这真的很快：看这个：

Sub RemoveEmptyRows()
On Error Resume Next
    Columns("A:A").Select
    Selection.SpecialCells(xlCellTypeBlanks).Select
    Selection.Delete Shift:=xlUp
    Range("A2").Select
End Sub

相关内容