none
Ajuda com listbox vba excel2003 RRS feed

  • Pergunta

  • Boa noite Pessoal!

    Minha Planilha(aplicativo rsrs) está ficando bem legal com a ajuda de vcs... Achei que seria mais fácil povoar os listbox dos meus forms, porém to tomando uma surra furiosa... hehehe

    no meu form o listbox vai possuir 3 ou 4 colunas. Ainda estou pensando... Há 4 botões que servem de filtro primario, mas também gostaria de adicionar um filtro por palavras.

    Nestes filtros o listbox deveria carregar ou os dados da planilha1, ou da planilha2 ou da planilha3 ou das 3 juntas.

    Li alguns topicos que dizem que o melhor caminho é utilizar um array e filtrar em outro array. Comecei pelo mais simples e tentei fazer um array de linhas variaveis, para carragar apenas as células não vazias. Mas não consegui colocar nem cabeçalho, nem fazer o array mudar seu tamanho conforme as linhas preenchidas. Poderiam me ajudar?

    Segue abaixo o código que estou utilizando:

    Dim n As Integer
    Dim Filtro1 As String
    Dim nmyarray As Long

    Private Sub CommandButton8_Click()

     Dim n, n2 As Long
     
     
      With Sheets("Jogos")
        nLast = .Cells(.Rows.Count, "A").End(xlUp).Row 'Ler última célula preenchida da coluna A e atribuir a nLast.
        nmyarray = nLast
        End With
    Preenche (nmyarray)
       
       
    End Sub
    Private Sub Preenche(nmyarray)
     Dim MyArray(nmyarray, 2)
     ' procurar modo de montar um array flexivel conforme o filtro
     'tentar saber como popular listbox multi colunas e
     'como adicionar os itens no cabeçalho do list box
     
      With Sheets("Jogos")
        nLast = .Cells(.Rows.Count, "A").End(xlUp).Row 'Ler última célula preenchida da coluna A e atribuir a nLast.
        For n = 1 To nLast
           If .Cells(n, "A").Value <> vbNullString Then
           n2 = n - 1
           MyArray(n2, 0) = .Cells(n, "A")
           MyArray(n2, 1) = .Cells(n, "B")
           MyArray(n2, 2) = .Cells(n, "C")
          End If
        Next n
      End With
      ListBox1.List() = MyArray

    End Sub

    Porém me retorna um erro de compilação: Expressão constante obrigatória e marca a variavel "myarray"

    Encontrei um filtro para planilhas que achei muito util, porém gostaria de saber se há como faze-lo em um form do vba.

    Segue o filtro:

    Sub Macro1()
    '
    ' Macro1 Macro
    ' Macro gravada em 22/08/2008 por Make Software
    '

    '
        Columns("H:L").Select
        Selection.EntireColumn.Hidden = True
    End Sub

    Private Sub TextBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)

       If KeyCode = 13 Then
            ListBox1.RowSource = ""
            pesquisa
        End If
    End Sub

    Sub pesquisa()
        Dim n%
        n = 1
        Range("H2:l65536").Clear
        Range("a2").Select
        Do While ActiveCell <> ""
            If InStr(1, ActiveCell, TextBox1) > 0 Then
                'Endereco = ActiveCell.Address
                Range("h" & n).Offset(1, 0).Value = ActiveCell
                Range("h" & n).Offset(1, 1).Value = ActiveCell.Offset(0, 1)
                Range("h" & n).Offset(1, 2).Value = ActiveCell.Offset(0, 2)
                Range("h" & n).Offset(1, 3).Value = ActiveCell.Offset(0, 3)
                Range("h" & n).Offset(1, 4).Value = ActiveCell.Offset(0, 4)
                n = n + 1
            End If
               ActiveCell.Offset(1, 0).Select
        Loop
        If n > 1 Then
            ListBox1.RowSource = "h2:l" & n
        Else
            ListBox1.RowSource = ""
            MsgBox "Nenhum registro encontrado", vbInformation, "Aviso"
        End If
    End Sub

    Desde Já Agradeço a ajuda. Abraços!

    quarta-feira, 13 de fevereiro de 2013 23:06

Respostas

  • Bom dia Pessoal,

    MInhas questões sobre popular o listbox com itens de mais de uma planilha(sheet) já ficou sanado em quase sua plenitude.

    Faltam ainda:

    - ordem alfabetica dentro do array Geral(com dados das 3 planilhas), vou deixar pra outro topico

    -Filtro por Palavra vou abrir outro tópico

    Nos demais desisti do cabeçalho, coloquei 3 labels para a função

    As linhas de comando ficaram assim:

    Private Sub CommandButtonA1_Click()
    OrientaBotao (1)
    PreencheFinal ("Todos")
    End Sub

    Private Sub CommandButtonA2_Click()
    OrientaBotao (2)
    PreencheFinal ("Jogos")
    End Sub

    Private Sub CommandButtonA3_Click()
    OrientaBotao (3)
    PreencheFinal ("Wads")
    End Sub

    Private Sub CommandButtonA4_Click()
    OrientaBotao (4)
    PreencheFinal ("Aplicativos")
    End Sub

     

    Private Sub OrientaBotao(bu)

    Select Case bu
    Case 1
    Filtro1 = "Todos"
    Case 2
    Filtro1 = "Jogos"
    Case 3
    Filtro1 = "WiiWares"
    Case 4
    Filtro1 = "Aplicativos"
    End Select

    For x = 1 To 4
    Controls("CommandButtonA" & x).Enabled = True
    Next x
    Controls("CommandButtonA" & bu).Enabled = False
    End Sub

     

    Private Sub PreencheFinal(parametro)
    Dim nLast As Long
    Dim nJogos, nWads, nAplic, nTodos As Long

     
     With ThisWorkbook.Sheets("Jogos")
        nLast = .Cells(.Rows.Count, "A").End(xlUp).Row 'Ler última célula preenchida da coluna A e atribuir a nLast.
        nJogos = nLast - 3
        ReDim MyArray(nJogos, 2)
        For n = 3 To nLast
           If .Cells(n, "A").Value <> vbNullString Then
           n2 = n - 3
           MyArray(n2, 0) = .Cells(n, "A")
           MyArray(n2, 1) = .Cells(n, "B")
           MyArray(n2, 2) = .Cells(n, "C")
          End If
        Next n
     End With

       With ThisWorkbook.Sheets("Wads-VCs")
        nLast = .Cells(.Rows.Count, "A").End(xlUp).Row 'Ler última célula preenchida da coluna A e atribuir a nLast.
        nWads = nLast - 3
        ReDim MyArray1(nWads, 2)
        For n = 3 To nLast
           If .Cells(n, "A").Value <> vbNullString Then
           n2 = n - 3
           MyArray1(n2, 0) = .Cells(n, "A")
           MyArray1(n2, 1) = .Cells(n, "B")
           MyArray1(n2, 2) = .Cells(n, "C")
           End If
        Next n
       
     End With
       
       With ThisWorkbook.Sheets("Aplicativos")
        nLast = .Cells(.Rows.Count, "A").End(xlUp).Row 'Ler última célula preenchida da coluna A e atribuir a nLast.
        nAplic = nLast - 3
        ReDim MyArray2(nAplic, 2)
        For n = 3 To nLast
           If .Cells(n, "A").Value <> vbNullString Then
           n2 = n - 3
           MyArray2(n2, 0) = .Cells(n, "A")
           MyArray2(n2, 1) = .Cells(n, "B")
           MyArray2(n2, 2) = .Cells(n, "C")
           End If
        Next n
       
        End With
       
        nTodos = nJogos + nWads + nAplic + 2


    'unir arrays 0, 1, 2 no array F
     
     ReDim MyArrayF(nTodos, 2)
     lbf = LBound(MyArrayF)
     ubf = UBound(MyArrayF)
     
       lb = LBound(MyArray) 'indice menor myarray
       ub = UBound(MyArray) 'indice maior myarray
       ub1 = UBound(MyArray1) 'indice maior myarray1
       ub2 = UBound(MyArray2) 'indice maior myarray2
      
       For n = 0 To ub
       MyArrayF(n, 0) = MyArray(n, 0)
       MyArrayF(n, 1) = MyArray(n, 1)
       MyArrayF(n, 2) = MyArray(n, 2)
       Next n
      
      
       For n = 0 To ub1
       n2 = n + ub + 1
       MyArrayF(n2, 0) = MyArray1(n, 0)
       MyArrayF(n2, 1) = MyArray1(n, 1)
       MyArrayF(n2, 2) = MyArray1(n, 2)
       Next n
      
      For n = 0 To ub2
       n2 = n + ub + ub1 + 2
       MyArrayF(n2, 0) = MyArray2(n, 0)
       MyArrayF(n2, 1) = MyArray2(n, 1)
       MyArrayF(n2, 2) = MyArray2(n, 2)
       Next n

    Select Case parametro
    Case "Todos"
    ListBox1.List() = MyArrayF

    Case "Jogos"
    ListBox1.List() = MyArray
    Case "Wads"
    ListBox1.List() = MyArray1
    Case "Aplicativos"
    ListBox1.List() = MyArray2
    End Select

    End Sub

    • Marcado como Resposta Ilário Júnior sábado, 16 de fevereiro de 2013 14:23
    sábado, 16 de fevereiro de 2013 14:23

Todas as Respostas

  • Boa noite Ilário!

    Já me deparei com esse problema, e a resposta é incrivelmente estranha (pelo menos pra mim): você não pode declarar uma vetor ou matriz com uma variável! Você precisa declarar como "()" e depois redimensioná-la, como no exemplo:

    Dim MyArray()
    ReDim MyArray(nmyarray, 2)

    Fazendo isso acho que resolve (não analisei o restante do código).

    Espero ter ajudado! Um abraço.


    Filipe Magno

    • Sugerido como Resposta Aslan kelvin segunda-feira, 29 de abril de 2013 12:46
    quinta-feira, 14 de fevereiro de 2013 01:26
  • Boa Felipe Magno...

    Agora consegui redimensionar meus arrays... nunca imaginei que primeiro tinha que declara-los sem parametros e depois redimenciona-los... Valeu a Dica.

    Mas ainda estou tomando uma saranda pra colocar os cabeçalhos e moldar aquele filtro pro meu array... Já coloquei como true a opção de columsheads, mas a primeira linha não entra como cabeçalho! o cabeçalho permanece vazio!!

    Vou tentando enjambrar alguma coisa aqui, mas se alguém puder me ajudar estou aceitando...heheheh

    Abraços pessoal e mais uma vez obrigado ao Felipe pela dica.

    • Sugerido como Resposta Aslan kelvin segunda-feira, 29 de abril de 2013 12:31
    • Não Sugerido como Resposta Aslan kelvin segunda-feira, 29 de abril de 2013 12:31
    sexta-feira, 15 de fevereiro de 2013 00:50
  • Bom dia Pessoal,

    MInhas questões sobre popular o listbox com itens de mais de uma planilha(sheet) já ficou sanado em quase sua plenitude.

    Faltam ainda:

    - ordem alfabetica dentro do array Geral(com dados das 3 planilhas), vou deixar pra outro topico

    -Filtro por Palavra vou abrir outro tópico

    Nos demais desisti do cabeçalho, coloquei 3 labels para a função

    As linhas de comando ficaram assim:

    Private Sub CommandButtonA1_Click()
    OrientaBotao (1)
    PreencheFinal ("Todos")
    End Sub

    Private Sub CommandButtonA2_Click()
    OrientaBotao (2)
    PreencheFinal ("Jogos")
    End Sub

    Private Sub CommandButtonA3_Click()
    OrientaBotao (3)
    PreencheFinal ("Wads")
    End Sub

    Private Sub CommandButtonA4_Click()
    OrientaBotao (4)
    PreencheFinal ("Aplicativos")
    End Sub

     

    Private Sub OrientaBotao(bu)

    Select Case bu
    Case 1
    Filtro1 = "Todos"
    Case 2
    Filtro1 = "Jogos"
    Case 3
    Filtro1 = "WiiWares"
    Case 4
    Filtro1 = "Aplicativos"
    End Select

    For x = 1 To 4
    Controls("CommandButtonA" & x).Enabled = True
    Next x
    Controls("CommandButtonA" & bu).Enabled = False
    End Sub

     

    Private Sub PreencheFinal(parametro)
    Dim nLast As Long
    Dim nJogos, nWads, nAplic, nTodos As Long

     
     With ThisWorkbook.Sheets("Jogos")
        nLast = .Cells(.Rows.Count, "A").End(xlUp).Row 'Ler última célula preenchida da coluna A e atribuir a nLast.
        nJogos = nLast - 3
        ReDim MyArray(nJogos, 2)
        For n = 3 To nLast
           If .Cells(n, "A").Value <> vbNullString Then
           n2 = n - 3
           MyArray(n2, 0) = .Cells(n, "A")
           MyArray(n2, 1) = .Cells(n, "B")
           MyArray(n2, 2) = .Cells(n, "C")
          End If
        Next n
     End With

       With ThisWorkbook.Sheets("Wads-VCs")
        nLast = .Cells(.Rows.Count, "A").End(xlUp).Row 'Ler última célula preenchida da coluna A e atribuir a nLast.
        nWads = nLast - 3
        ReDim MyArray1(nWads, 2)
        For n = 3 To nLast
           If .Cells(n, "A").Value <> vbNullString Then
           n2 = n - 3
           MyArray1(n2, 0) = .Cells(n, "A")
           MyArray1(n2, 1) = .Cells(n, "B")
           MyArray1(n2, 2) = .Cells(n, "C")
           End If
        Next n
       
     End With
       
       With ThisWorkbook.Sheets("Aplicativos")
        nLast = .Cells(.Rows.Count, "A").End(xlUp).Row 'Ler última célula preenchida da coluna A e atribuir a nLast.
        nAplic = nLast - 3
        ReDim MyArray2(nAplic, 2)
        For n = 3 To nLast
           If .Cells(n, "A").Value <> vbNullString Then
           n2 = n - 3
           MyArray2(n2, 0) = .Cells(n, "A")
           MyArray2(n2, 1) = .Cells(n, "B")
           MyArray2(n2, 2) = .Cells(n, "C")
           End If
        Next n
       
        End With
       
        nTodos = nJogos + nWads + nAplic + 2


    'unir arrays 0, 1, 2 no array F
     
     ReDim MyArrayF(nTodos, 2)
     lbf = LBound(MyArrayF)
     ubf = UBound(MyArrayF)
     
       lb = LBound(MyArray) 'indice menor myarray
       ub = UBound(MyArray) 'indice maior myarray
       ub1 = UBound(MyArray1) 'indice maior myarray1
       ub2 = UBound(MyArray2) 'indice maior myarray2
      
       For n = 0 To ub
       MyArrayF(n, 0) = MyArray(n, 0)
       MyArrayF(n, 1) = MyArray(n, 1)
       MyArrayF(n, 2) = MyArray(n, 2)
       Next n
      
      
       For n = 0 To ub1
       n2 = n + ub + 1
       MyArrayF(n2, 0) = MyArray1(n, 0)
       MyArrayF(n2, 1) = MyArray1(n, 1)
       MyArrayF(n2, 2) = MyArray1(n, 2)
       Next n
      
      For n = 0 To ub2
       n2 = n + ub + ub1 + 2
       MyArrayF(n2, 0) = MyArray2(n, 0)
       MyArrayF(n2, 1) = MyArray2(n, 1)
       MyArrayF(n2, 2) = MyArray2(n, 2)
       Next n

    Select Case parametro
    Case "Todos"
    ListBox1.List() = MyArrayF

    Case "Jogos"
    ListBox1.List() = MyArray
    Case "Wads"
    ListBox1.List() = MyArray1
    Case "Aplicativos"
    ListBox1.List() = MyArray2
    End Select

    End Sub

    • Marcado como Resposta Ilário Júnior sábado, 16 de fevereiro de 2013 14:23
    sábado, 16 de fevereiro de 2013 14:23