none
Filtro em listbox com array vba excel2003 RRS feed

  • Pergunta

  • Boa tarde Pessoal.

    Estou monatndo uma planilha de meus jogos. No form que mostra os jogos, dicas, etc, coloquei um filtro primário com 4 botões. Eles filtram os 3 tipos e o 4 é de tudo junto. Gostaria de adicionar um filtro por palavra, que filtrasse o array e criasse um novo array apenas com os itens que contivessem o que digitei no textbox.

    exemplo: se eu digitar "the" no textbox ele carregaria a listbox com o array de filtro que contivesse em qualquer das 3 colunas  o texto "the"

    Name                                                    Cod                      Regiao

    The world is big                                   RZZDER                   PAL

    super tennis                                         YGTHE6                  PAL

    Mario Kart                                            78YXCP                   ThE

    Tentei utilizar o seguinte código, mas sem sucesso:

    Private Sub FiltroArrays()
    Dim ub, ubf, n As Integer
    Dim Busca, Expr0, Expr1, Expr2 As String


    Select Case Filtro1
    Case "Todos"

    Case "Jogos"

    ubf = 0
    ub = UBound(MyArray)
    Busca = TextBox1.Value

    For n = 0 To ub
    Expr0 = MyArray(n, 0)
    Expr1 = MyArray(n, 1)
    Expr2 = MyArray(n, 2)
    If (InStr(1, Busca, Expr0) > 0) Or (InStr(1, Busca, Expr1) > 0) Or (InStr(1, Busca, Expr2) > 0) Then
    ubf = ubf + 1
    ReDim FiltroArray(ubf, 2)
    FiltroArray(ubf, 0) = MyArray(n, 0)
    FiltroArray(ubf, 1) = MyArray(n, 1)
    FiltroArray(ubf, 2) = MyArray(n, 2)

    End If

    Next n
    ListBox1.List() = FiltroArray()

    Case "WiiWares"

    Case "Aplicativos"

    End Select
       
    End Sub

    ************************

    Segue o codigo do form Completo:

    Dim n As Integer
    Dim Filtro1 As String
    Dim nmyarray As Long
    Dim MyArray()
    Dim MyArray1()
    Dim MyArray2()
    Dim MyArrayF()
    Dim FiltroArray()

    Private Sub CommandButton8_Click()
    FiltroArrays

    End Sub

    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 'laço repete ação até variável limite. X é variável início e incrementada
    Controls("CommandButtonA" & x).Enabled = True
    Next x 'repete o laço se não chegou ainda no limite
    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

    Private Sub FiltroArrays()
    Dim ub, ubf, n As Integer
    Dim Busca, Expr0, Expr1, Expr2 As String


    Select Case Filtro1
    Case "Todos"

    Case "Jogos"

    ubf = 0
    ub = UBound(MyArray)
    Busca = TextBox1.Value

    For n = 0 To ub
    Expr0 = MyArray(n, 0)
    Expr1 = MyArray(n, 1)
    Expr2 = MyArray(n, 2)
    If (InStr(1, Busca, Expr0) > 0) Or (InStr(1, Busca, Expr1) > 0) Or (InStr(1, Busca, Expr2) > 0) Then
    ubf = ubf + 1
    ReDim FiltroArray(ubf, 2)
    FiltroArray(ubf, 0) = MyArray(n, 0)
    FiltroArray(ubf, 1) = MyArray(n, 1)
    FiltroArray(ubf, 2) = MyArray(n, 2)

    End If

    Next n
    ListBox1.List() = FiltroArray()

    Case "WiiWares"

    Case "Aplicativos"

    End Select
       
       
       
       
    End Sub

    Conto com a ajuda de vcs.

    Desde já Obrigado.


    • Editado Ilário Júnior sábado, 16 de fevereiro de 2013 15:20 Flatou um pedaço do código
    sábado, 16 de fevereiro de 2013 15:18

Respostas

  • Bah gente,

    Acabei conseguindo mais ou menos o que queria, fui corrigindo conforme os erros iam aparecendo.

    Mas ficaram algumas duvidas, tipo li em vários sites da internet que arrays aceitavam valores negativos tipo:

    Dim myarray(-13, 32)

    E no site que mais encontrei informações estava assim declarado alguns exemplos de array.

    mas fiz uma gambiarrinha com if para corrigir isto.

    Se alguém possuir alguma melhoria para sugerir aceito de todo coração.

    Abraços a todos e um ótimo fim de Domingo.

    P.S.: Segue meu código

    Dim n As Integer
    Dim Filtro1 As String
    Dim nmyarray As Long
    Dim MyArray()
    Dim MyArray1()
    Dim MyArray2()
    Dim MyArrayF()
    Dim FiltroArray()

    Private Sub UserForm_Activate()
    Filtro1 = "Todos"
    PreencheFinal (Filtro1)

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

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

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

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

    Private Sub TextBox1_Keyup(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
       If KeyCode = 13 Then
        FiltroArrays
        MsgBox "deu enter"
       Else
        FiltroArrays
       End If
    End Sub


    Private Sub OrientaBotao(bu)

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

    For x = 1 To 4 'laço repete ação até variável limite. X é variável início e incrementada
    Controls("CommandButtonA" & x).Enabled = True
    Next x 'repete o laço se não chegou ainda no limite
    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

     

    Private Sub FiltroArrays()

    Dim ub, ubf As Long
    Dim Busca, Campo0, Campo1, Campo2 As String

    Select Case Filtro1
    Case "Jogos"
    ub = UBound(MyArray)
    ubf = 0
    Busca = TextBox1.Value

    For n = 0 To ub
    Campo0 = MyArray(n, 0)
    Campo1 = MyArray(n, 1)
    Campo2 = MyArray(n, 2)
    If (InStr(1, Campo0, Busca, 1) > 0) Or (InStr(1, Campo1, Busca, 1) > 0) Or (InStr(1, Campo2, Busca, 1) > 0) Then
    ubf = ubf + 1
    End If
    Next n
    If ubf <= 0 Then
    ubf = 0
    Else
    ubf = ubf - 1
    End If
    ReDim FiltroArray(ubf, 2)
    ubf = 0

    For n = 0 To ub
    Campo0 = MyArray(n, 0)
    Campo1 = MyArray(n, 1)
    Campo2 = MyArray(n, 2)
    If (InStr(1, Campo0, Busca, 1) > 0) Or (InStr(1, Campo1, Busca, 1) > 0) Or (InStr(1, Campo2, Busca, 1) > 0) Then
    FiltroArray(ubf, 0) = MyArray(n, 0)
    FiltroArray(ubf, 1) = MyArray(n, 1)
    FiltroArray(ubf, 2) = MyArray(n, 2)
    ubf = ubf + 1
    End If
    Next n

    ListBox1.List() = FiltroArray

     

    Case "Todos"
    ub = UBound(MyArrayF)
    ubf = 0
    Busca = TextBox1.Value


    For n = 0 To ub
    Campo0 = MyArrayF(n, 0)
    Campo1 = MyArrayF(n, 1)
    Campo2 = MyArrayF(n, 2)
    If (InStr(1, Campo0, Busca, 1) > 0) Or (InStr(1, Campo1, Busca, 1) > 0) Or (InStr(1, Campo2, Busca, 1) > 0) Then
    ubf = ubf + 1
    End If
    Next n
    If ubf <= 0 Then
    ubf = 0
    Else
    ubf = ubf - 1
    End If
    ReDim FiltroArray(ubf, 2)
    ubf = 0

    For n = 0 To ub
    Campo0 = MyArrayF(n, 0)
    Campo1 = MyArrayF(n, 1)
    Campo2 = MyArrayF(n, 2)
    If (InStr(1, Campo0, Busca, 1) > 0) Or (InStr(1, Campo1, Busca, 1) > 0) Or (InStr(1, Campo2, Busca, 1) > 0) Then
    FiltroArray(ubf, 0) = MyArrayF(n, 0)
    FiltroArray(ubf, 1) = MyArrayF(n, 1)
    FiltroArray(ubf, 2) = MyArrayF(n, 2)
    ubf = ubf + 1
    End If
    Next n

    ListBox1.List() = FiltroArray

     

    Case "Wads"
    ub = UBound(MyArray1)
    ubf = 0
    Busca = TextBox1.Value


    For n = 0 To ub
    Campo0 = MyArray1(n, 0)
    Campo1 = MyArray1(n, 1)
    Campo2 = MyArray1(n, 2)
    If (InStr(1, Campo0, Busca, 1) > 0) Or (InStr(1, Campo1, Busca, 1) > 0) Or (InStr(1, Campo2, Busca, 1) > 0) Then
    ubf = ubf + 1
    End If
    Next n
    If ubf <= 0 Then
    ubf = 0
    Else
    ubf = ubf - 1
    End If
    ReDim FiltroArray(ubf, 2)
    ubf = 0

    For n = 0 To ub
    Campo0 = MyArray1(n, 0)
    Campo1 = MyArray1(n, 1)
    Campo2 = MyArray1(n, 2)
    If (InStr(1, Campo0, Busca, 1) > 0) Or (InStr(1, Campo1, Busca, 1) > 0) Or (InStr(1, Campo2, Busca, 1) > 0) Then
    FiltroArray(ubf, 0) = MyArray1(n, 0)
    FiltroArray(ubf, 1) = MyArray1(n, 1)
    FiltroArray(ubf, 2) = MyArray1(n, 2)
    ubf = ubf + 1
    End If
    Next n

    ListBox1.List() = FiltroArray

     

    Case "Aplicativos"
    ub = UBound(MyArray2)
    ubf = 0
    Busca = TextBox1.Value


    For n = 0 To ub
    Campo0 = MyArray2(n, 0)
    Campo1 = MyArray2(n, 1)
    Campo2 = MyArray2(n, 2)
    If (InStr(1, Campo0, Busca, 1) > 0) Or (InStr(1, Campo1, Busca, 1) > 0) Or (InStr(1, Campo2, Busca, 1) > 0) Then
    ubf = ubf + 1
    End If
    Next n
    If ubf <= 0 Then
    ubf = 0
    Else
    ubf = ubf - 1
    End If
    ReDim FiltroArray(ubf, 2)
    ubf = 0

    For n = 0 To ub
    Campo0 = MyArray2(n, 0)
    Campo1 = MyArray2(n, 1)
    Campo2 = MyArray2(n, 2)
    If (InStr(1, Campo0, Busca, 1) > 0) Or (InStr(1, Campo1, Busca, 1) > 0) Or (InStr(1, Campo2, Busca, 1) > 0) Then
    FiltroArray(ubf, 0) = MyArray2(n, 0)
    FiltroArray(ubf, 1) = MyArray2(n, 1)
    FiltroArray(ubf, 2) = MyArray2(n, 2)
    ubf = ubf + 1
    End If
    Next n

    ListBox1.List() = FiltroArray
    End Select
    End Sub

    • Marcado como Resposta Ilário Júnior quarta-feira, 20 de fevereiro de 2013 22:31
    domingo, 17 de fevereiro de 2013 20:46

Todas as Respostas

  • Bah gente,

    Acabei conseguindo mais ou menos o que queria, fui corrigindo conforme os erros iam aparecendo.

    Mas ficaram algumas duvidas, tipo li em vários sites da internet que arrays aceitavam valores negativos tipo:

    Dim myarray(-13, 32)

    E no site que mais encontrei informações estava assim declarado alguns exemplos de array.

    mas fiz uma gambiarrinha com if para corrigir isto.

    Se alguém possuir alguma melhoria para sugerir aceito de todo coração.

    Abraços a todos e um ótimo fim de Domingo.

    P.S.: Segue meu código

    Dim n As Integer
    Dim Filtro1 As String
    Dim nmyarray As Long
    Dim MyArray()
    Dim MyArray1()
    Dim MyArray2()
    Dim MyArrayF()
    Dim FiltroArray()

    Private Sub UserForm_Activate()
    Filtro1 = "Todos"
    PreencheFinal (Filtro1)

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

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

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

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

    Private Sub TextBox1_Keyup(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
       If KeyCode = 13 Then
        FiltroArrays
        MsgBox "deu enter"
       Else
        FiltroArrays
       End If
    End Sub


    Private Sub OrientaBotao(bu)

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

    For x = 1 To 4 'laço repete ação até variável limite. X é variável início e incrementada
    Controls("CommandButtonA" & x).Enabled = True
    Next x 'repete o laço se não chegou ainda no limite
    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

     

    Private Sub FiltroArrays()

    Dim ub, ubf As Long
    Dim Busca, Campo0, Campo1, Campo2 As String

    Select Case Filtro1
    Case "Jogos"
    ub = UBound(MyArray)
    ubf = 0
    Busca = TextBox1.Value

    For n = 0 To ub
    Campo0 = MyArray(n, 0)
    Campo1 = MyArray(n, 1)
    Campo2 = MyArray(n, 2)
    If (InStr(1, Campo0, Busca, 1) > 0) Or (InStr(1, Campo1, Busca, 1) > 0) Or (InStr(1, Campo2, Busca, 1) > 0) Then
    ubf = ubf + 1
    End If
    Next n
    If ubf <= 0 Then
    ubf = 0
    Else
    ubf = ubf - 1
    End If
    ReDim FiltroArray(ubf, 2)
    ubf = 0

    For n = 0 To ub
    Campo0 = MyArray(n, 0)
    Campo1 = MyArray(n, 1)
    Campo2 = MyArray(n, 2)
    If (InStr(1, Campo0, Busca, 1) > 0) Or (InStr(1, Campo1, Busca, 1) > 0) Or (InStr(1, Campo2, Busca, 1) > 0) Then
    FiltroArray(ubf, 0) = MyArray(n, 0)
    FiltroArray(ubf, 1) = MyArray(n, 1)
    FiltroArray(ubf, 2) = MyArray(n, 2)
    ubf = ubf + 1
    End If
    Next n

    ListBox1.List() = FiltroArray

     

    Case "Todos"
    ub = UBound(MyArrayF)
    ubf = 0
    Busca = TextBox1.Value


    For n = 0 To ub
    Campo0 = MyArrayF(n, 0)
    Campo1 = MyArrayF(n, 1)
    Campo2 = MyArrayF(n, 2)
    If (InStr(1, Campo0, Busca, 1) > 0) Or (InStr(1, Campo1, Busca, 1) > 0) Or (InStr(1, Campo2, Busca, 1) > 0) Then
    ubf = ubf + 1
    End If
    Next n
    If ubf <= 0 Then
    ubf = 0
    Else
    ubf = ubf - 1
    End If
    ReDim FiltroArray(ubf, 2)
    ubf = 0

    For n = 0 To ub
    Campo0 = MyArrayF(n, 0)
    Campo1 = MyArrayF(n, 1)
    Campo2 = MyArrayF(n, 2)
    If (InStr(1, Campo0, Busca, 1) > 0) Or (InStr(1, Campo1, Busca, 1) > 0) Or (InStr(1, Campo2, Busca, 1) > 0) Then
    FiltroArray(ubf, 0) = MyArrayF(n, 0)
    FiltroArray(ubf, 1) = MyArrayF(n, 1)
    FiltroArray(ubf, 2) = MyArrayF(n, 2)
    ubf = ubf + 1
    End If
    Next n

    ListBox1.List() = FiltroArray

     

    Case "Wads"
    ub = UBound(MyArray1)
    ubf = 0
    Busca = TextBox1.Value


    For n = 0 To ub
    Campo0 = MyArray1(n, 0)
    Campo1 = MyArray1(n, 1)
    Campo2 = MyArray1(n, 2)
    If (InStr(1, Campo0, Busca, 1) > 0) Or (InStr(1, Campo1, Busca, 1) > 0) Or (InStr(1, Campo2, Busca, 1) > 0) Then
    ubf = ubf + 1
    End If
    Next n
    If ubf <= 0 Then
    ubf = 0
    Else
    ubf = ubf - 1
    End If
    ReDim FiltroArray(ubf, 2)
    ubf = 0

    For n = 0 To ub
    Campo0 = MyArray1(n, 0)
    Campo1 = MyArray1(n, 1)
    Campo2 = MyArray1(n, 2)
    If (InStr(1, Campo0, Busca, 1) > 0) Or (InStr(1, Campo1, Busca, 1) > 0) Or (InStr(1, Campo2, Busca, 1) > 0) Then
    FiltroArray(ubf, 0) = MyArray1(n, 0)
    FiltroArray(ubf, 1) = MyArray1(n, 1)
    FiltroArray(ubf, 2) = MyArray1(n, 2)
    ubf = ubf + 1
    End If
    Next n

    ListBox1.List() = FiltroArray

     

    Case "Aplicativos"
    ub = UBound(MyArray2)
    ubf = 0
    Busca = TextBox1.Value


    For n = 0 To ub
    Campo0 = MyArray2(n, 0)
    Campo1 = MyArray2(n, 1)
    Campo2 = MyArray2(n, 2)
    If (InStr(1, Campo0, Busca, 1) > 0) Or (InStr(1, Campo1, Busca, 1) > 0) Or (InStr(1, Campo2, Busca, 1) > 0) Then
    ubf = ubf + 1
    End If
    Next n
    If ubf <= 0 Then
    ubf = 0
    Else
    ubf = ubf - 1
    End If
    ReDim FiltroArray(ubf, 2)
    ubf = 0

    For n = 0 To ub
    Campo0 = MyArray2(n, 0)
    Campo1 = MyArray2(n, 1)
    Campo2 = MyArray2(n, 2)
    If (InStr(1, Campo0, Busca, 1) > 0) Or (InStr(1, Campo1, Busca, 1) > 0) Or (InStr(1, Campo2, Busca, 1) > 0) Then
    FiltroArray(ubf, 0) = MyArray2(n, 0)
    FiltroArray(ubf, 1) = MyArray2(n, 1)
    FiltroArray(ubf, 2) = MyArray2(n, 2)
    ubf = ubf + 1
    End If
    Next n

    ListBox1.List() = FiltroArray
    End Select
    End Sub

    • Marcado como Resposta Ilário Júnior quarta-feira, 20 de fevereiro de 2013 22:31
    domingo, 17 de fevereiro de 2013 20:46
  • Bom gente, vou marcar a solução que encontrie como resposta, mas qualquer sugestão estamos ai...

    Valeu a todos

    quarta-feira, 20 de fevereiro de 2013 22:31