none
O DE FILTRO EM LIST BOX RRS feed

  • Pergunta

  • ESTOU PRECISANDO DE UMA AJUDA DE COMO RESOLVER OS ERRO DESSE CÓDIGO PARA FAZER UM FILTRO

    TEM UM VÍDEO DO QUE ESTA OCORRENDO.

    https://youtu.be/FSxqhvRr71U

    "


    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

    ""

    quarta-feira, 29 de julho de 2020 18:46

Respostas

  • A resposta está neste vídeo:

    https://youtu.be/A_CcwmaejIE

    Qualquer outra dúvida, neste mesmo canal tem mais de 500 vídeos sobre Excel VBA.


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


    • Sugerido como Resposta AndersonFDiniz2 quinta-feira, 30 de julho de 2020 00:48
    • Editado AndersonFDiniz2 quinta-feira, 30 de julho de 2020 01:15
    • Marcado como Resposta istinjaguar quinta-feira, 30 de julho de 2020 12:57
    quinta-feira, 30 de julho de 2020 00:48