Notifications
Clear all

Procurar palavra em celulas

7 Posts
4 Usuários
0 Reactions
1,734 Visualizações
Felipe Ecks
(@ecks)
Posts: 48
Trusted Member
Topic starter
 

boa tarde, gostaria de saber como adaptar esse código.

If Range("A" & i).Value = "Teste"

Esse código em minha planilha ele procura a referencia exata "Teste" e deleta a linha inteira... porém se a celula estiver escrito "teste" ou for "0teste" ele não consegue encontrar e logicamente não exclui a linha..
Alguma ajuda de como fazer esse codigo encontrar as celulas que contenham a palavra teste.. ao inves de so localizar a referencia exata?

desde ja agradeço!

 
Postado : 07/05/2018 11:34 am
xlarruda
(@xlarruda)
Posts: 732
Honorable Member
 

Faça:

Option Compare Text
Sub Teste()
If Range("A" & i).Value = "*" & "teste" & "*"
End Sub

___________________________________________________________________________________________
Se a resposta atendeu sua dúvida, por favor, clique no Gostei e marque o Tópico como [Resolvido].

Att.

André Arruda

 
Postado : 07/05/2018 11:42 am
leandroxtr
(@leandroxtr)
Posts: 447
Reputable Member
 

Tente:

If UCASE(Range("A" & i).Value) = "TESTE"

Obs: Essa solução só vai ajudar caso a diferença da condição para o valor procurado for letras maiúsculas e minúsculas.

Se te ajudou, não se esqueça de dar um like na resposta e marcar o tópico como finalizado.

Abraços!
Leandro Cordeiro

 
Postado : 07/05/2018 11:42 am
(@srobles)
Posts: 231
Estimable Member
 

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
Felipe Ecks
(@ecks)
Posts: 48
Trusted Member
Topic starter
 

Bom, testei e tentei os códigos indicados, porém não obtive sucesso...
anexei a planilha para que possam ter ideia do que estou tentado fazer..

como na imagem..
Ao clicar no botao apagar todo o conteudo que tenha a palavra "teste" precisa ser apagado.. assim como todas as celulas que contenham "resumo por produtos", "data:", entre outros..
Porem, o código da planilha so consegue achar e apagar um..
A ideia é que o codigo leia o dado da celula e encontrando a palavra "teste" apague a linha inteira..
Desde ja agradeço!

 
Postado : 07/05/2018 1:10 pm
(@srobles)
Posts: 231
Estimable Member
 

ecks,

Experimente a rotina que deixo abaixo :

Sub apagarDados()
    With ThisWorkbook.Sheets("Plan1")
        Dim linhaAtual, linhaFinal, contador As Long
        Dim valorCelula As String
        Dim deletar As Boolean
        
        linhaAtual = 2
        linhaFinal = Cells(Rows.Count, 1).End(xlUp).Row
        
        contador = 0
        deletar = False
        
        Application.ScreenUpdating = False
        While linhaAtual <= linhaFinal
            valorCelula = Cells(linhaAtual, 1)
            
                If LCase(valorCelula) Like LCase("*Teste*") Then
                    deletar = True
                End If
                If LCase(valorCelula) Like LCase("*Resumo por produtos*") Then
                    deletar = True
                End If
                
                If LCase(valorCelula) Like LCase("*produto red.*") Then
                    deletar = True
                End If
                
                If LCase(valorCelula) Like LCase("*data:*") Then
                    deletar = True
                End If
                
                If LCase(valorCelula) Like LCase("*dt.emiss*") Then
                    deletar = True
                End If
                
                If LCase(valorCelula) Like LCase("*empresa*") Then
                    deletar = True
                End If
                
                If LCase(valorCelula) Like LCase("*C.E.V.S*") Then
                    deletar = True
                End If
                
                If deletar = False Then
                    linhaAtual = linhaAtual + 1
                Else
                    contador = contador + 1
                    Cells(linhaAtual, 1).EntireRow.Delete
                    linhaAtual = linhaAtual
                    deletar = False
                End If
                linhaFinal = Cells(Rows.Count, 1).End(xlUp).Row
        Wend
    End With
    Application.ScreenUpdating = True
    
    If contador = 0 Then
        MsgBox "Não existem dados para remover!", vbExclamation, "Erro"
    Else
        MsgBox "Dados removidos com sucesso!" & vbCrLf & _
        "Total de " & contador & " registro(s) removido(s).", vbInformation, "Apagar dados"
    End If
End Sub

Espero ter ajudado.

Abs

Espero ter ajudado.

Abs.

Saulo Robles

 
Postado : 07/05/2018 2:09 pm
Felipe Ecks
(@ecks)
Posts: 48
Trusted Member
Topic starter
 

srobles, extremamente perfeito...
muito obrigado... consegui inserir o codigo na planilha original.. e ficou perfeito.. muito obrigado mesmo!

 
Postado : 07/05/2018 3:25 pm