Notifications
Clear all

Excluir linhas

9 Posts
2 Usuários
0 Reactions
1,869 Visualizações
(@mario-l-cremonese)
Posts: 26
Eminent Member
Topic starter
 

Prezados amigos,
Encontrei na Net o código abaixo, aliás excelente. Gostaria de adaptá-lo para executar o seguinte:
Na coluna "A", tenho diversos tipos importados de um arquivo texto, por exemplo:
1 -2 - 3 - 4 - 5 - 6 - 7.......
Gostaria que o código, uma vez informado o tipo ou os tipos (ao mesmo tempo) nessa coluna, fossem excluídas as linhas correspondentes, através de um único imputbox.
Antecipo meus agradecimentos pela colaboração.
Cremonese

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),
'Extraindo texto para coluna ativa (mas com o A1) select será direcionada para 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
'Se um intervalo inválido for inserido em seguida, sair
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
'nao deixe de ver nosso trabalho com 100 planilhas exemplos Loops (com todas as intruções Do/While/Loop/until/For Next/)
End If
'Se houver condição verdadeira exclua as linhas
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
'caso queira retirar a mensagem vbyesno.
' If Not DeletaRange Is Nothing Then DeletaRange.EntireRow.Delete

End Sub

 
Postado : 15/07/2013 6:53 am
Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Bom dia!!

Eu não entendi muito bem, tente usar a pesquisa do fórum.
viewtopic.php?f=10&t=7163
viewtopic.php?f=10&t=6978
viewtopic.php?f=10&t=6531
viewtopic.php?f=5&t=4071
viewtopic.php?f=10&t=8505

Att

Existem mil maneiras de preparar Neston. Invente a sua!
http://www.youtube.com/ExpressoExcel

 
Postado : 15/07/2013 8:47 am
(@mario-l-cremonese)
Posts: 26
Eminent Member
Topic starter
 

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
Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Mario, facilitaria se anexar um modelo reduzido com os dados da origem e com o resultado final, só pela rotina e a explicação fica um pouco dificil a analise e chegar a um resultado positivo.

[]s

Existem mil maneiras de preparar Neston. Invente a sua!
http://www.youtube.com/ExpressoExcel

 
Postado : 16/07/2013 6:51 am
(@mario-l-cremonese)
Posts: 26
Eminent Member
Topic starter
 

Mauro,
Por favor, veja se o arquivo está anexado.
Muito obrigado.
Mario L Cremonese

 
Postado : 16/07/2013 7:33 am
Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Não sei se entendi exatamente o que deseja, mas veja se o codigo abaixo está na direção do que precisa.
No input box, digite as palavras que deseja excluir separadas por ";" (sem as aspas)

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),
     
    'Extraindo texto para coluna ativa (mas com o A1) select será direcionada para 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
     
     'Se um intervalo inválido for inserido em seguida, sair
    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
    vcol = Split(vProcuraTexto, ";")
     
    Application.ScreenUpdating = False
     'para coincidir com a seqüência de texto TODO
    x = UBound(vcol)
    For x = 0 To UBound(vcol)
    Set vColuna = vRange.Find(What:=vcol(x), 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
        'nao deixe de ver nosso trabalho com 100 planilhas exemplos Loops (com todas as intruções Do/While/Loop/until/For Next/)
    End If
           
     'Se houver condição verdadeira exclua as linhas
          sbx = MsgBox("As Linhas contendo a palavra [ " & vcol(x) & " ] 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
      'caso queira retirar a mensagem vbyesno.
 '    If Not DeletaRange Is Nothing Then DeletaRange.EntireRow.Delete
  Next
End Sub

Existem mil maneiras de preparar Neston. Invente a sua!
http://www.youtube.com/ExpressoExcel

 
Postado : 16/07/2013 10:11 am
(@mario-l-cremonese)
Posts: 26
Eminent Member
Topic starter
 

Reinaldo,
Estamos chegando próximo do que pretendo.
Você poderia dar uma olhadinha na planilha anexa?
Eu gostaria que a macro ao ser executada, abrisse uma caixa de diálogo diretamente na célula "A", quando então eu digitaria os dados a serem excluídos da forma como recomendou, ou seja, ";" (sem as aspas.).
Agradeço pela gentileza da sua atenção.
Mario L Cremonese

 
Postado : 16/07/2013 11:17 am
Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Não entendi?
O que considera "uma caixa de diálogo diretamente na célula "A"" ?
Se o que deseja e não ter a primeira input box, e que o código sempre avalie a coluna "A" para exclusão, altere a linha -->vProcuraColuna = InputBox....;
para vProcuraColuna = vColunaAtiva ou vColunaAtiva="A"
Se não for isso ?

Existem mil maneiras de preparar Neston. Invente a sua!
http://www.youtube.com/ExpressoExcel

 
Postado : 16/07/2013 11:26 am
(@mario-l-cremonese)
Posts: 26
Eminent Member
Topic starter
 

Reinaldo,
Troquei o nome do input box, perdão.
Resolvido com a sua ajuda.
Muito obrigado.
Mario L Cremonese

 
Postado : 16/07/2013 12:00 pm