Fóruns
Microsoft Excel - 2...
2024 - VBA & Macros
Pesquisar palavra e...
 
Notifications
Clear all

Pesquisar palavra em qualquer lugar

 
2024 - VBA & Macros
Post Recente por Wagner Morel 11 anos atrás
4 Posts
2 Usuários
0 Reactions
1,220 Visualizações
RSS
 bilokas
(@bilokas)
Posts: 168
Estimable Member
Topic starter
 

Galera, venho mais uma vez pedir a ajuda dos amigos do fórum.

com textbox1 e listbox1 (nomes padrão), o código abaixo lista o conteúdo de 2 colunas na listbox1 e a textbox1 serve como filtro, conforme digitado, vai mostrando o resultado. Porém ele só encontra conteúdo na primeira coluna e também a primeira palavra, ou seja, se for uma frase e a palavra digitada não for a primeira da frase ele não encontra.

Preciso que ele encontre a palavra ou palavras digitadas no textbox1, estejam elas em qualquer lugar da sheet selecionada.

Option Explicit
Private TextoDigitado As String
Private Sub TextBox1_Change()
    TextoDigitado = TextBox1.Text
    Call PreencheLista
End Sub
 
Private Sub UserForm_Initialize()
    Call PreencheLista
End Sub
 
Private Sub PreencheLista()
    Dim ws As Worksheet
    Dim i As Integer
    Dim TextoCelula As String
    Set ws = Worksheets("base")
    i = 1
    ListBox1.Clear
    With ws
        While .Cells(i, 2).Value <> Empty
            TextoCelula = .Cells(i, 2).Value
            If UCase(Left(TextoCelula, Len(TextoDigitado))) = UCase(TextoDigitado) Then
                ListBox1.AddItem .Cells(i, 1)
                ListBox1.List(UserForm1.ListBox1.ListCount - 1, 1) = Worksheets("base").Range("B" & i)
            End If
            i = i + 1
        Wend
    End With
End Sub


DGAF / DVGD - Divisão de Gestão de Documentos
Rafael A. Guimarães
[email protected]

 
Postado : 03/10/2013 9:48 am
Wagner Morel
 Wagner Morel
(@wagner-morel-vidal-nobre)
Posts: 0
Illustrious Member
 

bilokas,

Boa Tarde!

tente assim:

Private Sub TextBox1_Change()
    TextoDigitado = TextBox1.Text
    Call PreencheLista
End Sub
Private Sub UserForm_Initialize()
    Call PreencheLista
End Sub
Private Sub PreencheLista()
    Dim ws As Worksheet
    Dim i As Integer
    Dim TextoCelula As String
    Set ws = Worksheets("base")
    i = 1
    ListBox1.Clear
    With ws
        While .Cells(i, 2).Value <> Empty
            TextoCelula = .Cells(i, 2).Value
            If UCase(TextoCelula) Like UCase("*" & TextoDigitado & "*") Then
                ListBox1.AddItem .Cells(i, 2)
                ListBox1.List(UserForm1.ListBox1.ListCount - 1, 1) = Worksheets("base").Range("B" & i)
            End If
            i = i + 1
        Wend
    End With
End Sub

Desenvolvo pequenas soluções em VBA Excel a valores que variam entre R$ 50,00 a R$ 200,00. Se te interessar, entre no meu instagran (vba_excel_desenvolvimento)

Atenciosamente
Wagner Morel

 
Postado : 03/10/2013 12:00 pm
 bilokas
(@bilokas)
Posts: 168
Estimable Member
Topic starter
 

Wagner Morel, obrigado pela resposta, mas eu não consegui aplicar a modificação no meu projeto :/


DGAF / DVGD - Divisão de Gestão de Documentos
Rafael A. Guimarães
[email protected]

 
Postado : 03/10/2013 12:18 pm
Wagner Morel
 Wagner Morel
(@wagner-morel-vidal-nobre)
Posts: 0
Illustrious Member
 

Bem... não fiz alteraçções radicais. Você pode copiar o meu código em cima do seu e pronto!

    Private Sub TextBox1_Change()
        TextoDigitado = TextBox1.Text
        Call PreencheLista
    End Sub
    Private Sub UserForm_Initialize()
        Call PreencheLista
    End Sub
    Private Sub PreencheLista()
        Dim ws As Worksheet
        Dim i As Integer
        Dim TextoCelula As String
        Set ws = Worksheets("base")
        i = 1
        ListBox1.Clear
        With ws
            While .Cells(i, 2).Value <> Empty
                TextoCelula = .Cells(i, 2).Value
                If UCase(TextoCelula) Like UCase("*" & TextoDigitado & "*") Then
                    ListBox1.AddItem .Cells(i, 1)
                    ListBox1.List(UserForm1.ListBox1.ListCount - 1, 1) = Worksheets("base").Range("B" & i)
                End If
                i = i + 1
            Wend
        End With
    End Sub

A única linha alterada foi essa:
If UCase(TextoCelula) Like UCase("*" & TextoDigitado & "*") Then

Desenvolvo pequenas soluções em VBA Excel a valores que variam entre R$ 50,00 a R$ 200,00. Se te interessar, entre no meu instagran (vba_excel_desenvolvimento)

Atenciosamente
Wagner Morel

 
Postado : 03/10/2013 1:35 pm
Forum Jump:
  Tópico Anterior
Próximo Tópico