none
criação de filtro em um list box RRS feed

  • Pergunta

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


    """
    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""
    alguem saberia me ajudar com esse erro

    sexta-feira, 24 de julho de 2020 16:39

Respostas

  • 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 cbpesquisa_Change()
       If cbpesquisa.Value = "Cidadão" Then
                    planilha = "Cidadão"
                    tabela = "Cidadao"
                    Else
               End
               
            End If
    End Sub
    
    Private Sub txtpesquisa_Change()
    If Me.txtpesquisa.Text <> "" Then
        TextoDigitado = TextBox1.Text
        If cbpesquisa.ListIndex >= 0 Then
        Call PreencheLista
        End If
        
        Else
        Me.ListBox1.Clear
        
        End If
    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()
    If Me.TextBox1.Text <> "" Then
        TextoDigitado = TextBox1.Text
        If cbpesquisa.ListIndex >= 0 Then
        Call PreencheLista
        End If
        
        Else
        Me.ListBox1.Clear
        
        End If
    End Sub
    
    Private Sub PreencheLista()
        Dim ws As Worksheet
        Dim tb As ListObjects
        Dim i As Integer
        Dim TextoCelula As String
        Dim linhaListBox As Long
        Set ws = ThisWorkbook.Worksheets(planilha)
        Set lo = ThisWorkbook.Worksheets(planilha).ListObjects(tabela)
        
        ListBox1.ColumnCount = lo.ListColumns.Count
        i = 1
        ListBox1.Clear
        linhaListBox = 0
        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).Value
                   ' ListBox1.List(linhaListBox, 1) = .Cells(i, 2).Value
                   ' ListBox1.List(linhaListBox, 2) = .Cells(i, 3).Value
                    'linhaListBox = linhaListBox + 1
                End If
                i = i + 1
            Wend
        End With
    End Sub
    
    Private Sub UserForm_Terminate()
    txtpesquisa.Enabled = False
    End Sub
    


    A melhor forma de agradecer e votar como util e / ou marcar como resposta. Anderson Diniz diniabr2011@gmail.com

    • Sugerido como Resposta AndersonFDiniz2 sexta-feira, 24 de julho de 2020 18:49
    • Marcado como Resposta istinjaguar quinta-feira, 30 de julho de 2020 12:30
    sexta-feira, 24 de julho de 2020 18:02
  • https://youtu.be/d7C972T19cM

    A melhor forma de agradecer e votar como util e / ou marcar como resposta. Anderson Diniz diniabr2011@gmail.com

    • Sugerido como Resposta AndersonFDiniz2 sexta-feira, 24 de julho de 2020 19:08
    • Marcado como Resposta istinjaguar quinta-feira, 30 de julho de 2020 12:30
    sexta-feira, 24 de julho de 2020 19:08

Todas as Respostas

  • 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 cbpesquisa_Change()
       If cbpesquisa.Value = "Cidadão" Then
                    planilha = "Cidadão"
                    tabela = "Cidadao"
                    Else
               End
               
            End If
    End Sub
    
    Private Sub txtpesquisa_Change()
    If Me.txtpesquisa.Text <> "" Then
        TextoDigitado = TextBox1.Text
        If cbpesquisa.ListIndex >= 0 Then
        Call PreencheLista
        End If
        
        Else
        Me.ListBox1.Clear
        
        End If
    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()
    If Me.TextBox1.Text <> "" Then
        TextoDigitado = TextBox1.Text
        If cbpesquisa.ListIndex >= 0 Then
        Call PreencheLista
        End If
        
        Else
        Me.ListBox1.Clear
        
        End If
    End Sub
    
    Private Sub PreencheLista()
        Dim ws As Worksheet
        Dim tb As ListObjects
        Dim i As Integer
        Dim TextoCelula As String
        Dim linhaListBox As Long
        Set ws = ThisWorkbook.Worksheets(planilha)
        Set lo = ThisWorkbook.Worksheets(planilha).ListObjects(tabela)
        
        ListBox1.ColumnCount = lo.ListColumns.Count
        i = 1
        ListBox1.Clear
        linhaListBox = 0
        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).Value
                   ' ListBox1.List(linhaListBox, 1) = .Cells(i, 2).Value
                   ' ListBox1.List(linhaListBox, 2) = .Cells(i, 3).Value
                    'linhaListBox = linhaListBox + 1
                End If
                i = i + 1
            Wend
        End With
    End Sub
    
    Private Sub UserForm_Terminate()
    txtpesquisa.Enabled = False
    End Sub
    


    A melhor forma de agradecer e votar como util e / ou marcar como resposta. Anderson Diniz diniabr2011@gmail.com

    • Sugerido como Resposta AndersonFDiniz2 sexta-feira, 24 de julho de 2020 18:49
    • Marcado como Resposta istinjaguar quinta-feira, 30 de julho de 2020 12:30
    sexta-feira, 24 de julho de 2020 18:02
  • https://youtu.be/d7C972T19cM

    A melhor forma de agradecer e votar como util e / ou marcar como resposta. Anderson Diniz diniabr2011@gmail.com

    • Sugerido como Resposta AndersonFDiniz2 sexta-feira, 24 de julho de 2020 19:08
    • Marcado como Resposta istinjaguar quinta-feira, 30 de julho de 2020 12:30
    sexta-feira, 24 de julho de 2020 19:08
  • https://youtu.be/IIEu_ES66_E
    segunda-feira, 27 de julho de 2020 13:07
  • https://youtu.be/k__GdinXyKA

    A melhor forma de agradecer e votar como util e / ou marcar como resposta. Anderson Diniz diniabr2011@gmail.com

    segunda-feira, 27 de julho de 2020 14:04
  • BOM DIA ANDERSON GOSTEI DA SUA EXPLICAÇÃO SÓ QUE NÃO RESOLVEU O MEU PROBLEMA, 

    RETIREI PARTES DOS CÓDIGOS QUE ESTAVA CONFUSO ORGANIZEI AS VARIÁVEL EM UM LUGAR SÓ PARA FICAR COM UM INTENDIMENTO MELHOR.

    "


    Option Explicit
    Dim CW As Variant
    Dim Values As Variant
    Dim ws As Worksheet
    Dim tb As ListObject
    Dim i As Integer
    Dim TextoCelula As String
    Dim linhaListBox As Long
    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
            ' A COMPLEMENTO PARA O CODIGO IF ACIMA.
        
        Set tb = ThisWorkbook.Worksheets(planilha).ListObjects(tabela)
        
        ListBox1.ColumnCount = tb.ListColumns.Count
        Values = tb.DataBodyRange.Text
        Debug.Print tb.DataBodyRange.Address(, , , 1)
        ListBox1.RowSource = tb.DataBodyRange.Address(, , , 1)
        
        UpdateCW
        txtpesquisa.Enabled = True
       
    End Sub


    Private Sub btnSair_Click()
        Unload Me
    End Sub



    Sub UpdateCW()
        CW = tb.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

    Private Sub PreencheLista()
        Set ws = ThisWorkbook.Worksheets(planilha)
        Set tb = ThisWorkbook.Worksheets(planilha).ListObjects(tabela)
        i = 1
        ListBox1.Clear
        linhaListBox = 0
        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

    ""

    segunda-feira, 27 de julho de 2020 14:08
  • https://studio.youtube.com/video/KgA_WYrODzA/edit

    A melhor forma de agradecer e votar como util e / ou marcar como resposta. Anderson Diniz diniabr2011@gmail.com


    segunda-feira, 27 de julho de 2020 15:49