A macro do Excel para excluir linhas vazias não está parando

Question

Como faço para parar depois de uma certa quantidade de linhas?

Eu fiz um curso de VBA e meu professor explicou como excluir linhas vazias. Agora estou tentando colocar isso em prática, mas minha macro não está parando. Eu pensei que tinha limitado a 200 linhas.

Estou sentindo falta de algo importante. Quaisquer ponteiros muito apreciados.

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

'Start at the top of the list

Esse é o problema. Ao excluir linhas, sempre inicie no final da lista para evitar um loop infinito.

Percorra o código. Ele excluirá as linhas vazias acima das células preenchidas e, passo a passo, selecionará as células preenchidas. Depois disso, ele selecionará a célula vazia abaixo das células preenchidas e excluirá essa linha.

Se essa linha for, por exemplo, linha 35, a linha 35 será excluída. Mas as linhas abaixo irão mover uma para cima, para que você nunca realmente exclua a linha 35. Após a exclusão, a seleção ainda fica na linha 35. Portanto, você tem um loop infinito.

Crie o loop de baixo para cima.

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

Isso provavelmente pode ser feito de maneira mais elegante, mas esperamos que você comece.

    

Answer 2

Este código é mais elegante, como diz o usuário acima. Mas se você tem 800 + linhas, leva um acerto na memória por algum motivo.

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

passou por mais uma vez e isso é muito rápido: Veja isto:

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