Ir para conteúdo
Fórum Script Brasil
  • 1

criação de filtro em um list box


isinmg

Pergunta

bom dia estou tentando criar um formulario de pesquisa com list box mais um filtro no text box, mas estou tendo dificuldades.

image.thumb.png.99497fc744a8e4d9fe719f9e6fbc6b80.pngimage.thumb.png.66d1a0ab41cbed4378853f7b8875f452.pngimage.thumb.png.d3cbfadbf8fda41514b62ca4f420a15c.png

"""
Option Explicit

Dim lo As ListObject
Private planilha As String
Private tabela As String
Private TextoDigitado As String

Private Sub btncarrega_Click()
   If cbpesquisa.Value = "Cidadão" Then
                planilha = "Cidadão"
                tabela = "Cidadao"
                Else
           End
           
        End If
    Dim Values As Variant
    
    Set lo = ThisWorkbook.Worksheets(planilha).ListObjects(tabela)
    
    ListBox1.ColumnCount = lo.ListColumns.Count
    Values = lo.DataBodyRange.Text
'    ListBox1.List = Values
    
    Debug.Print lo.DataBodyRange.Address(, , , 1)
    ListBox1.RowSource = lo.DataBodyRange.Address(, , , 1)
    
    UpdateCW
    txtpesquisa.Enabled = True
   
End Sub

Private Sub btnpesquisa_Click()

End Sub

Private Sub btnSair_Click()
    Unload Me
End Sub

Sub UpdateCW()
    Dim CW As Variant
    
    'ListBox1.ColumnWidths = "200;200;200;200;200"
    CW = lo.HeaderRowRange.Offset(-1).Value2
    CW = Application.Transpose(CW)
    CW = Application.Transpose(CW)
    
    ListBox1.ColumnWidths = Join(CW, ";")
End Sub


Private Sub txtpesquisa_Change()
 TextoDigitado = txtpesquisa.Text
 Call PreencheLista
End Sub


Private Sub UserForm_Initialize()
Me.cbpesquisa.RowSource = "cbo!r4:r17"
txtpesquisa.Enabled = False
End Sub


'       [Excel Avançado - Macros e Vba]


Private Sub TextBox1_Change()
    TextoDigitado = TextBox1.Text
    Call PreencheLista
End Sub

Private Sub PreencheLista()
    Dim ws As Worksheet
    Dim tb As ListObjects
    Dim i As Integer
    Dim TextoCelula As String
    Set ws = ThisWorkbook.Worksheets(planilha).ListObjects(tabela)
    i = 1
    ListBox1.Clear
    With ws
        While .Cells(i, 1).Value <> Empty
            TextoCelula = .Cells(i, 1).Value
            If UCase(Left(TextoCelula, Len(TextoDigitado))) = UCase(TextoDigitado) Then
                ListBox1.AddItem .Cells(i, 1)
            End If
            i = i + 1
        Wend
    End With
End Sub

Private Sub UserForm_Terminate()
txtpesquisa.Enabled = False
End Sub""
alguém saberia me ajudar com esse erro

Link para o comentário
Compartilhar em outros sites

0 respostass a esta questão

Posts Recomendados

Até agora não há respostas para essa pergunta

Participe da discussão

Você pode postar agora e se registrar depois. Se você já tem uma conta, acesse agora para postar com sua conta.

Visitante
Responder esta pergunta...

×   Você colou conteúdo com formatação.   Remover formatação

  Apenas 75 emoticons são permitidos.

×   Seu link foi incorporado automaticamente.   Exibir como um link em vez disso

×   Seu conteúdo anterior foi restaurado.   Limpar Editor

×   Você não pode colar imagens diretamente. Carregar ou inserir imagens do URL.



  • Estatísticas dos Fóruns

    • Tópicos
      152,1k
    • Posts
      651,8k
×
×
  • Criar Novo...