Este fórum está sendo desativado

[Wieniawski]

Olá!

Preciso por favor de um código VBA para exclusão de linhas de acordo com determinado critério, ou seja, que toda linha cuja coluna B conste valores acima de 8000000000 sejam excluídas.

Alguém poderia me ajudar?

Grato!

[gfranco]

Boa tarde.
Veja se te ajuda.

Código: Selecionar todos

Option Explicit

Sub excluir()

Dim w As Worksheet
Dim lastRowData As Long
Dim i As Long
Dim valor As Variant
Dim counter As Long



Set w = ActiveSheet
counter = 0
lastRowData = w.Cells(w.Rows.Count, 2).End(3).Row

If lastRowData < 2 Then GoTo finaliza

valor = InputBox("Informe valor para exclusão", "Atenção")


If Not VBA.IsNumeric(valor) Then

MsgBox "Um valor não numérico foi informado" & _
VBA.Chr(13) & "Processo abortado"
GoTo finaliza
End If


valor = valor + 0

    For i = 1 To lastRowData
    
        If w.Cells(i, 2) > valor Then
        
            w.Cells(i, 2) = ""
            counter = counter + 1
        End If
    
    Next i

    If counter > 0 Then
    
        w.Range("b1:b" & lastRowData).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
    End If
    
finaliza:

Set w = Nothing

End Sub

[gfranco]

Nota:
A planilha ativa (no momento da execução do código acima) deve ser a planilha alvo da exclusão.

[Wieniawski]

Obrigado Gfranco, mas infelizmente a macro não funcionou, quando coloco o valor na msgbox só exclui o cabeçalho da planilha.

[gfranco]

Sugiro, então, postar um exemplo (idêntico ao original) para uma melhor escrita.

[Wieniawski]

Segue anexo

[Wieniawski]

gfranco, é possível excluir sem a mensagem?

[gfranco]

Para esse último modelo postado, eu utilizaria o seguinte código:

Código: Selecionar todos

Sub excluir()

Dim w As Worksheet
Dim lastRowData As Long
Dim i As Long
Dim valor As Variant
Dim counter As Long



Set w = ActiveSheet
counter = 0
lastRowData = w.Cells(w.Rows.Count, 2).End(3).Row

If lastRowData < 2 Then GoTo finaliza

valor = 8000000000



    For i = 2 To lastRowData
   
        If w.Cells(i, 2) > valor Then
       
            w.Cells(i, 2) = ""
            counter = counter + 1
        End If
   
    Next i

    If counter > 0 Then
   
        w.Range("b1:b" & lastRowData).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
    End If
   
finaliza:

Set w = Nothing

End Sub

[osvaldomp]

Código: Selecionar todos

Sub ExcluiLinhas()
 With ActiveSheet
  .AutoFilterMode = False
  .Range("A1:D" & Cells(Rows.Count, 1).End(3).Row).AutoFilter 2, ">8000000000"
  .Range("A2:D" & Cells(Rows.Count, 1).End(3).Row).SpecialCells(xlCellTypeVisible).EntireRow.Delete
  .AutoFilterMode = False
 End With
End Sub

[Wieniawski]

Para esse último modelo postado, eu utilizaria o seguinte código:

Código: Selecionar todos

Sub excluir()

Dim w As Worksheet
Dim lastRowData As Long
Dim i As Long
Dim valor As Variant
Dim counter As Long



Set w = ActiveSheet
counter = 0
lastRowData = w.Cells(w.Rows.Count, 2).End(3).Row

If lastRowData < 2 Then GoTo finaliza

valor = 8000000000



    For i = 2 To lastRowData
   
        If w.Cells(i, 2) > valor Then
       
            w.Cells(i, 2) = ""
            counter = counter + 1
        End If
   
    Next i

    If counter > 0 Then
   
        w.Range("b1:b" & lastRowData).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
    End If
   
finaliza:

Set w = Nothing

End Sub

Agora ficou perfeito, muito obrigado gfranco!

[Wieniawski]

Código: Selecionar todos

Sub ExcluiLinhas()
 With ActiveSheet
  .AutoFilterMode = False
  .Range("A1:D" & Cells(Rows.Count, 1).End(3).Row).AutoFilter 2, ">8000000000"
  .Range("A2:D" & Cells(Rows.Count, 1).End(3).Row).SpecialCells(xlCellTypeVisible).EntireRow.Delete
  .AutoFilterMode = False
 End With
End Sub

Também deu certo desta forma, muito obrigado osvaldomp!