none
Ajuda em Macro Análise e Delete ? RRS feed

  • Pergunta

  • Prezados,

    tenho a macro abaixo, conforme quantidade de linhas que informo, a mesma analisa essa quantidade, e vai deletando todas as linhas em brancos encontradas.

    Só que eu preciso saber a quantidade de linhas, alguns relatórios possuem mais de 30.000 linhas, existe a possibilidade desse valor ser preenchido automaticamente na InputBox, ficando apenas a necessidade de clicar em Ok ?

    Obs.: É uma planilha (Macro) que mando sempre abrir só para tratamento dos meus relatórios que gero diariamente.

    Segue Código:

    Dim Counter
    Dim i As Integer
     
    Sub Del_linhas()
     
    ' Determinar a quantidade de linhas a ser avaliada para tratamento.
        Counter = InputBox("Entre com a quantidade de linhas a ser avaliada")
        ActiveCell.Select
        ' Loop até a quantidade de Linhas.
        For i = 1 To Counter
            ' Checar se as linhas estão brancos
            If ActiveCell = "" Then
                Selection.EntireRow.Delete
     
                Counter = Counter - 1
            Else
                ' Selecionar novar células
                ActiveCell.Offset(1, 0).Select
            End If
     
        Next i
     
    End Sub

    Att, Estanislau Frade msn: lauedele@hotmail.com email: estanislaufrade@yahoo.com.br estanislau.frade@vale.com


    • Editado Estanislau Frade quinta-feira, 23 de agosto de 2012 14:52 Rev. Código
    quinta-feira, 23 de agosto de 2012 14:51

Respostas

  • Quando for apagar linhas, faça um laço que comece da última linha até a primeira. É mais confiável.

    Desabilite as atualizações de tela no início da execução do laço e ative-as novamente ao término da macro.

    Sub Exemplo()
        Dim lIni As Long
        Dim lFim As Long
        Dim lRow As Long
    
        With ActiveSheet
            lIni = .UsedRange.Cells(1).Row
            lFim = .UsedRange.Rows.Count + lIni - 1
        
            Application.ScreenUpdating = False
            For lRow = lFim To lIni Step -1
                If WorksheetFunction.CountA(.Rows(lRow)) = 0 Then
                    .Rows(lRow).Delete
                End If
            Next lRow
            Application.ScreenUpdating = True
        End With
    
    End Sub


    Felipe Costa Gualberto - http://www.ambienteoffice.com.br

    • Marcado como Resposta Estanislau Frade sexta-feira, 24 de agosto de 2012 11:46
    quinta-feira, 23 de agosto de 2012 21:58
    Moderador

Todas as Respostas

  • Quando for apagar linhas, faça um laço que comece da última linha até a primeira. É mais confiável.

    Desabilite as atualizações de tela no início da execução do laço e ative-as novamente ao término da macro.

    Sub Exemplo()
        Dim lIni As Long
        Dim lFim As Long
        Dim lRow As Long
    
        With ActiveSheet
            lIni = .UsedRange.Cells(1).Row
            lFim = .UsedRange.Rows.Count + lIni - 1
        
            Application.ScreenUpdating = False
            For lRow = lFim To lIni Step -1
                If WorksheetFunction.CountA(.Rows(lRow)) = 0 Then
                    .Rows(lRow).Delete
                End If
            Next lRow
            Application.ScreenUpdating = True
        End With
    
    End Sub


    Felipe Costa Gualberto - http://www.ambienteoffice.com.br

    • Marcado como Resposta Estanislau Frade sexta-feira, 24 de agosto de 2012 11:46
    quinta-feira, 23 de agosto de 2012 21:58
    Moderador
  • Ótimo, ficou perfeito.


    Att, Estanislau Frade msn: lauedele@hotmail.com email: estanislaufrade@yahoo.com.br estanislau.frade@vale.com

    sexta-feira, 24 de agosto de 2012 11:46