Макрос Excel для удаления пустых строк не останавливается

Question

Как сделать так, чтобы это останавливалось после определенного количества строк?

Я прошел курс 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

Answer 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

Вероятно, это можно сделать более элегантным способом, но, надеюсь, это даст вам начало.

Answer 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