none
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.
    Friday, February 12, 2010 7:25 PM

Answers

  • 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é..
    • Marked as answer by rogerio8197 Saturday, February 20, 2010 10:43 PM
    Thursday, February 18, 2010 12:34 PM

All replies

  • 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é..
    • Marked as answer by rogerio8197 Saturday, February 20, 2010 10:43 PM
    Thursday, February 18, 2010 12:34 PM
  • 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

    Wednesday, April 07, 2010 8:42 PM