Usuário com melhor resposta
Filtro em listbox com array vba excel2003

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.ValueFor 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()
FiltroArraysEnd Sub
Private Sub CommandButtonA1_Click()
OrientaBotao (1)
PreencheFinal ("Todos")
End SubPrivate Sub CommandButtonA2_Click()
OrientaBotao (2)
PreencheFinal ("Jogos")
End SubPrivate Sub CommandButtonA3_Click()
OrientaBotao (3)
PreencheFinal ("Wads")
End SubPrivate Sub CommandButtonA4_Click()
OrientaBotao (4)
PreencheFinal ("Aplicativos")
End SubPrivate Sub OrientaBotao(bu)
Select Case bu
Case 1
Filtro1 = "Todos"
Case 2
Filtro1 = "Jogos"
Case 3
Filtro1 = "WiiWares"
Case 4
Filtro1 = "Aplicativos"
End SelectFor 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 SubPrivate 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 WithWith 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 nSelect Case parametro
Case "Todos"
ListBox1.List() = MyArrayF
Case "Jogos"
ListBox1.List() = MyArray
Case "Wads"
ListBox1.List() = MyArray1
Case "Aplicativos"
ListBox1.List() = MyArray2
End SelectEnd 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.ValueFor 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 SubConto 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
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 SubPrivate Sub CommandButtonA2_Click()
OrientaBotao (2)
PreencheFinal ("Jogos")
FiltroArrays
End SubPrivate Sub CommandButtonA3_Click()
OrientaBotao (3)
PreencheFinal ("Wads")
FiltroArrays
End SubPrivate Sub CommandButtonA4_Click()
OrientaBotao (4)
PreencheFinal ("Aplicativos")
FiltroArrays
End SubPrivate 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 SelectFor 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 SubPrivate 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 WithWith 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 nSelect Case parametro
Case "Todos"
ListBox1.List() = MyArrayF
Case "Jogos"
ListBox1.List() = MyArray
Case "Wads"
ListBox1.List() = MyArray1
Case "Aplicativos"
ListBox1.List() = MyArray2
End SelectEnd Sub
Private Sub FiltroArrays()
Dim ub, ubf As Long
Dim Busca, Campo0, Campo1, Campo2 As StringSelect Case Filtro1
Case "Jogos"
ub = UBound(MyArray)
ubf = 0
Busca = TextBox1.ValueFor 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 = 0For 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 nListBox1.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 = 0For 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 nListBox1.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 = 0For 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 nListBox1.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 = 0For 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 nListBox1.List() = FiltroArray
End Select
End Sub- Marcado como Resposta Ilário Júnior quarta-feira, 20 de fevereiro de 2013 22:31
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 SubPrivate Sub CommandButtonA2_Click()
OrientaBotao (2)
PreencheFinal ("Jogos")
FiltroArrays
End SubPrivate Sub CommandButtonA3_Click()
OrientaBotao (3)
PreencheFinal ("Wads")
FiltroArrays
End SubPrivate Sub CommandButtonA4_Click()
OrientaBotao (4)
PreencheFinal ("Aplicativos")
FiltroArrays
End SubPrivate 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 SelectFor 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 SubPrivate 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 WithWith 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 nSelect Case parametro
Case "Todos"
ListBox1.List() = MyArrayF
Case "Jogos"
ListBox1.List() = MyArray
Case "Wads"
ListBox1.List() = MyArray1
Case "Aplicativos"
ListBox1.List() = MyArray2
End SelectEnd Sub
Private Sub FiltroArrays()
Dim ub, ubf As Long
Dim Busca, Campo0, Campo1, Campo2 As StringSelect Case Filtro1
Case "Jogos"
ub = UBound(MyArray)
ubf = 0
Busca = TextBox1.ValueFor 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 = 0For 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 nListBox1.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 = 0For 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 nListBox1.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 = 0For 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 nListBox1.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 = 0For 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 nListBox1.List() = FiltroArray
End Select
End Sub- Marcado como Resposta Ilário Júnior quarta-feira, 20 de fevereiro de 2013 22:31
-