Caro Alexandre,
Em primeiro lugar agradeço a gentileza da sua atenção.
Creio que com a explicação abaixo você poderá entender melhor o que pretendo.
Abraço
A B
1 Carlos > A macro atual cujo código segue abaixo, faz o seguinte:
1 Antonio > 1) Abre uma caixa de diálogo pedindo a coluna que contém o dado a ser excluído;
1 Tereza > 2) Abre uma nova caixa pedindo o dado a ser excluído.
2 Clara
2 Fulano > O que pretendo:
2 Ciclano > 1) Abrir uma caixa de diálogo onde eu possa digitar o dado a ser excluído, podendo ser múltiplos dados.
3 Armando
3 José
3 Fernando
3 André
' Macro atual
Sub sbx_deletar_linhas_baseado_criterios()
Dim vRange As Range, DeletaRange As Range, vColuna As Range
Dim vProcuraTexto As String, vProcuraColuna As String, vColunaAtiva As String
Dim PrimeiroEndereco As String, CheckaNulo As String
Dim SCA
[A1].Select ' Para selecionar a coluna(A),
SCA = Split(ActiveCell.EntireColumn.Address(, False), ":")
vColunaAtiva = SCA(0)
vProcuraColuna = InputBox("Digite a coluna desejada ou cancela para sair", "Linha código para deletar", vColunaAtiva)
On Error Resume Next
Set vRange = Columns(vProcuraColuna)
On Error GoTo 0
If vRange Is Nothing Then Exit Sub
vProcuraTexto = InputBox("Entre com o texto procurado", "Deleta código linha", [A1].Value) 'ActiveCell.Value)
If vProcuraTexto = "" Then
CheckaNulo = InputBox("Você realmente deseja excluir linhas com células vazias?" & vbNewLine & vbNewLine & _
"Sim quero, caso contrário sairá código", "Cuidado", "Não")
If CheckaNulo <> "Sim" Then Exit Sub
End If
Application.ScreenUpdating = False
'para coincidir com a seqüência de texto TODO
Set vColuna = vRange.Find(What:=vProcuraTexto, After:=vRange.Cells(1), LookIn:=xlValues, Lookat:=xlWhole)
'para corresponder a uma cadeia de texto PARCIAL use esta linha
'Set vColuna = vRange.Find(What:=vProcuraTexto, After:=vRange.Cells(1), LookIn:=xlValues, Lookat:=xlpart)
'para coincidir com o caso e de uma cadeia de texto TODO
'Set vColuna = vRange.Find(What:=vProcuraTexto, After:=vRange.Cells(1), LookIn:=xlValues, Lookat:=xlWhole, MatchCase:=True)
If Not vColuna Is Nothing Then
Set DeletaRange = vColuna
PrimeiroEndereco = vColuna.Address
Do
Set vColuna = vRange.FindNext(vColuna)
Set DeletaRange = Union(DeletaRange, vColuna)
Loop While PrimeiroEndereco <> vColuna.Address
End If
sbx = MsgBox("As Linhas contendo a palavra [ " & [A1] & " ] serão deletadas!!!", vbYesNo + vbCritical, "CUIDADO - AÇÃO IRREVERSÍVEL!!")
If sbx = 6 Then
If Not DeletaRange Is Nothing Then DeletaRange.EntireRow.Delete
End If
End Sub
Postado : 16/07/2013 5:35 am