Formulário de Pesquisa

Question

Ola pessoal.
criei um formulario de pesquisa no excel. a pesquisa funciona corretamente, mais presiso que essa pesquisa filtre valores para mim. segue o código.

Dim I%
    I = 0
    Plan4.Range("B1").Select
    Do While ActiveCell <> ""
        If InStr(1, ActiveCell, TextBox1) > 0 Then
            ListBox1.AddItem ActiveCell
            ListBox1.List(I, 1) = ActiveCell.Offset(0, 1).Value
            ListBox1.List(I, 2) = ActiveCell.Offset(0, 2).Value
             ListBox1.List(I, 3) = ActiveCell.Offset(0, 3).Value
             ListBox1.List(I, 4) = ActiveCell.Offset(0, 4).Value
             ListBox1.List(I, 5) = ActiveCell.Offset(0, 5).Value    (esse campo tem que ser maior que 0)
            ListBox1.List(I, 6) = ActiveCell.Offset(0, 6).Value
           
            I = I + 1
        End If
        ActiveCell.Offset(1, 0).Select
       
    Loop

Queria que na listbox só entrasse os valores com quantidade diferente de 0.

Se poderem me ajudar agradeço.

Answer 1

Olá...Faça assim
Note que neste exemplo não estou usando o select para selecionar células, pois isto deixaria a pesquisa mais lenta....Somente uso o indíce da linha e da coluna da propriedade cells...

Private Sub CommandButton1_Click()
    Dim I As Long
    I = 0
    ListBox1.Clear
    For r = 1 To Rows.Count
        If Cells(r, 2) = "" Then Exit For
        If InStr(1, Cells(r, 2), TextBox1) > 0 Then
            If Cells(r, 6) <> 0 Then ' se for diferente de 0 então adiciona o item
                ListBox1.AddItem Cells(r, 2)
                ListBox1.List(I, 2) = Cells(r, 3)
                ListBox1.List(I, 3) = Cells(r, 4)
                ListBox1.List(I, 4) = Cells(r, 5)
                ListBox1.List(I, 5) = Cells(r, 6)
                ListBox1.List(I, 6) = Cells(r, 7)
                ListBox1.List(I, 7) = Cells(r, 8)
                I = I + 1
            End If
        End If
    Next
End Sub

Qualquer dúvida post denovo..
Se solucionar marque como resposta..
Até..

Answer 2

Caro Amigo pode me ajudar neste codigo para que o mesmo me retorne no textbox3 valor em hora, tentei o format mais não deu certo segue o codigo para analise;

 

Public MatrizResultados As Variant
Public Total_Ocorrencias As Long

Private Sub btn_Procurar_Click()
    If Me.txt_Procurar.Text = "" Then
        MsgBox "Digite um valor para a pesquisa"
    Else
        Call ProcuraPersonalizada(Me.txt_Procurar.Text)
           End If
End Sub

Private Sub SpinButton1_Change()
Dim Linha As Long
Dim TotalOcorrencias As Long

    TotalOcorrencias = SpinButton1.Max + 1
    Linha = MatrizResultados(SpinButton1.Value)
   
    Label_Registros_Contador.Caption = SpinButton1.Value + 1 & " de " & TotalOcorrencias
    TextBox1.Text = Plan1.Cells(Linha, 1).Value
    TextBox2.Text = Plan1.Cells(Linha, 2).Value
    TextBox3.Text = Plan1.Cells(Linha, 3).Value
    TextBox4.Text = Plan1.Cells(Linha, 4).Value
    TextBox5.Text = Plan1.Cells(Linha, 5).Value
    TextBox6.Text = Plan1.Cells(Linha, 6).Value
    TextBox7.Text = Plan1.Cells(Linha, 7).Value
    TextBox8.Text = Plan1.Cells(Linha, 8).Value
    TextBox9.Text = Plan1.Cells(Linha, 9).Value
    TextBox10.Text = Plan1.Cells(Linha, 10).Value
    TextBox11.Text = Plan1.Cells(Linha, 11).Value
    TextBox12.Text = Plan1.Cells(Linha, 12).Value
    TextBox13.Text = Plan1.Cells(Linha, 13).Value
    TextBox14.Text = Plan1.Cells(Linha, 14).Value
    TextBox15.Text = Plan1.Cells(Linha, 15).Value
    TextBox16.Text = Plan1.Cells(Linha, 16).Value
    TextBox17.Text = Plan1.Cells(Linha, 17).Value
    TextBox18.Text = Plan1.Cells(Linha, 18).Value

End Sub

Private Sub ProcuraPersonalizada(ByVal TermoPesquisado As String)
Dim Busca As Range
Dim Primeira_Ocorrencia As String
Dim Resultados As String

    'Executa a busca
    Set Busca = Plan1.Cells.Find(What:=TermoPesquisado, After:=Range("A1"), LookIn:=xlFormulas, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False)
   
    'Caso tenha encontrado alguma ocorrência...
    If Not Busca Is Nothing Then
   
        Primeira_Ocorrencia = Busca.Address
        Resultados = Busca.Row  'Lista o primeiro resultado na variavel
   
        'Neste loop, pesquisa todas as próximas ocorrências para
        'o termo pesquisado
        Do
            Set Busca = Plan1.Cells.FindNext(After:=Busca)
       
            'Condicional para não listar o primeiro resultado
            'pois já foi listado acima
            If Not Busca.Address Like Primeira_Ocorrencia Then
                Resultados = Resultados & ";" & Busca.Row
            End If
        Loop Until Busca.Address Like Primeira_Ocorrencia
   
   
        MatrizResultados = Split(Resultados, ";")
       
        'Atualiza dados iniciais no formulário
        SpinButton1.Max = UBound(MatrizResultados)  'Valor maximo do seletor de registros
       
        'habilita o seletor de registro
        SpinButton1.Enabled = True
       
        'indicador do seletor de registros
        Label_Registros_Contador.Caption = "1 de " & UBound(MatrizResultados) + 1
       
       
        'Box com o conteudo encontrado
        TextBox1.Text = Plan1.Cells(MatrizResultados(0), 1).Value
        TextBox2.Text = Plan1.Cells(MatrizResultados(0), 2).Value
        TextBox3.Text = Plan1.Cells(MatrizResultados(0), 3).Value
        TextBox4.Text = Plan1.Cells(MatrizResultados(0), 4).Value
        TextBox5.Text = Plan1.Cells(MatrizResultados(0), 5).Value
        TextBox6.Text = Plan1.Cells(MatrizResultados(0), 6).Value
        TextBox7.Text = Plan1.Cells(MatrizResultados(0), 7).Value
        TextBox8.Text = Plan1.Cells(MatrizResultados(0), 8).Value
        TextBox9.Text = Plan1.Cells(MatrizResultados(0), 9).Value
        TextBox10.Text = Plan1.Cells(MatrizResultados(0), 10).Value
        TextBox11.Text = Plan1.Cells(MatrizResultados(0), 11).Value
        TextBox12.Text = Plan1.Cells(MatrizResultados(0), 12).Value
        TextBox13.Text = Plan1.Cells(MatrizResultados(0), 13).Value
        TextBox14.Text = Plan1.Cells(MatrizResultados(0), 14).Value
        TextBox15.Text = Plan1.Cells(MatrizResultados(0), 15).Value
        TextBox16.Text = Plan1.Cells(MatrizResultados(0), 16).Value
        TextBox17.Text = Plan1.Cells(MatrizResultados(0), 17).Value
        TextBox18.Text = Plan1.Cells(MatrizResultados(0), 18).Value
   
    Else    'Caso nada tenha sido encontrado, exibe mensagem informativa
   
        SpinButton1.Enabled = False     'desabilita o seletor de registros
        Label_Registros_Contador.Caption = ""   'zera os resultados encontrados
        'limpa os campos do formulário
        TextBox1.Text = ""
        TextBox2.Text = ""
        TextBox3.Text = ""
        TextBox4.Text = ""
        TextBox5.Text = ""
        TextBox6.Text = ""
        TextBox7.Text = ""
        TextBox8.Text = ""
        TextBox9.Text = ""
        TextBox10.Text = ""
        TextBox11.Text = ""
        TextBox12.Text = ""
        TextBox13.Text = ""
        TextBox14.Text = ""
        TextBox15.Text = ""
        TextBox16.Text = ""
        TextBox17.Text = ""
        TextBox18.Text = ""
   
        MsgBox "Nenhum resultado para '" & TermoPesquisado & "' foi encontrado."

    End If
   
End Sub

Private Sub UserForm_Initialize()

    SpinButton1.Enabled = False
    Label_Registros_Contador.Caption = ""
   
End Sub