Usuário com melhor resposta
Formulário de Pesquisa

Pergunta
-
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.
Respostas
-
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é..- Marcado como Resposta rogerio8197 sábado, 20 de fevereiro de 2010 22:43
Todas as Respostas
-
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é..- Marcado como Resposta rogerio8197 sábado, 20 de fevereiro de 2010 22:43
-
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 SubPrivate 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 SubPrivate Sub UserForm_Initialize()
SpinButton1.Enabled = False
Label_Registros_Contador.Caption = ""
End Sub