ecks,
Experimente o que segue abaixo :
Adicione o bloco de códigos abaixo em um módulo.
Sub pesquisarTermo()
Dim caixaPesquisa As String
inicio:
caixaPesquisa = Application.InputBox("Informe o valor á ser pesquisado :", "Pesquisa")
Select Case caixaPesquisa
Case Is = False
MsgBox "Operação cancelada pelo usuário!", vbExclamation, "Operação cancelada"
Case Is = ""
If MsgBox("Nenhum valor informado!" & Chr(13) & _
"Realizar nova pesquisa?", vbQuestion + vbYesNo, "Valor não informado!") = vbYes Then
GoTo inicio
Else
Exit Sub
End If
Case Is <> ""
excluirRegistro caixaPesquisa
End Select
End Sub
Function excluirRegistro(ByVal TermoPesquisado As String)
Dim vBusca
Dim contador, ultimaLinha As Long
With ThisWorkbook.ActiveSheet
With .Range("A:AA")
ultimaLinha = Cells(Rows.Count, 1).End(xlUp).Row
Set vBusca = .Find(TermoPesquisado, LookIn:=xlValues, LookAt:=xlPart)
If Not vBusca Is Nothing Then
.Range(vBusca.Address).Select
primeiraOcorrencia = vBusca.Address
contador = contador + 1
Do
Set vBusca = .FindNext(Range(primeiraOcorrencia))
If Not vBusca Is Nothing Then
.Range(vBusca.Address).Select
contador = contador + 1
ActiveCell.EntireRow.Delete
End If
ultimaLinha = Cells(Rows.Count, 1).End(xlUp).Row
Loop While ActiveCell.Row <= ultimaLinha
If .Range(primeiraOcorrencia) Like "*" & TermoPesquisado & "*" Then .Range(primeiraOcorrencia).EntireRow.Delete
MsgBox "Operação realizada com sucesso!" & Chr(13) & _
"Total de " & contador & " registro(s) removido(s).", vbInformation, "Remover registros"
End If
End With
End With
End Function
Chame a rotina PesquisaTermo e o restante é com a função.
Espero ter ajudado.
Abs
Espero ter ajudado.
Abs.
Saulo Robles
Postado : 07/05/2018 11:55 am