Usuário com melhor resposta
COMO INFORMAR EM UMA CAIXA DE TEXTO O RESULTADO DE OUTROS FILTROS DE UM FORMULARIO

Pergunta
-
PESSOAL COMO FAÇO PRA LANÇAR O PREÇO NA CAIXA DE TEXTO DO FORMULARIO? ALGUEM PODE ME AJUDAR?
http://uploaded.to/file/cxtiqy7h
LINK DAS FOTOS
SEGUE O MEU CODIGO ABAIXO
Private Sub cmdMenu_Click() Unload frmTabela frmMenu.Show End Sub Private Sub txtCodigo_Change() End Sub Private Sub UserForm_Initialize() Dim SomaAno As Long Dim A As Integer: Dim ArrAnoVal As Variant: Dim ListaAnoValor As String 'ATENÇÃO! se a coluna de sua planilha conter mais de 100 elementos aumente o valor d variavel "ArrAno" ReDim ArrAno(1000) Sheets("Tabela").Activate Sheets("Tabela").Select vAno = 0 SomaAno = vAno + 2 Do While ActiveSheet.Range("A" & Trim(SomaAno)) <> Empty ArrAno(vAno) = ActiveSheet.Range("A" & Trim(SomaAno)) vAno = vAno + 1 SomaAno = vAno + 1 Loop For A = LBound(ArrAno) To UBound(ArrAno) - 1 If A = 0 Then ListaAnoValor = ArrAno(A) Else If InStr(1, ListaAnoValor, ArrAno(A)) = 0 Then ListaAnoValor = ListaAnoValor & ";" & ArrAno(A) End If Next A ArrAnoVal = Split(ListaAnoValor, ";") ReDim ArrAno(UBound(ArrAnoVal)) frmTabela.cbAno.Clear For A = LBound(ArrAnoVal) To UBound(ArrAnoVal) frmTabela.cbAno.AddItem ArrAnoVal(A) Next End Sub Private Sub cbano_Change() Dim SomaModelo As Long Dim M As Integer: Dim ArrModVal As Variant: Dim ListaModValor As String 'ATENÇÃO! se a coluna de sua planilha conter mais de 100 elementos aumente o valor d variavel "ArrModelo" ReDim ArrModelo(1000) vMod = 0 SomaModelo = vMod + 2 If frmTabela.cbAno.Text <> Empty Then Do While ActiveSheet.Range("A" & Trim(SomaModelo)) <> Empty If ActiveSheet.Range("A" & Trim(SomaModelo)) = frmTabela.cbAno.Text And _ ActiveSheet.Range("B" & Trim(SomaModelo)) <> Empty Then ArrModelo(vMod) = ActiveSheet.Range("B" & Trim(SomaModelo)) vMod = vMod + 1 SomaModelo = SomaModelo + 1 Else SomaModelo = SomaModelo + 1 End If Loop End If For M = LBound(ArrModelo) To UBound(ArrModelo) - 1 If M = 0 Then ListaModValor = ArrModelo(M) Else If InStr(1, ListaModValor, ArrModelo(M)) = 0 Then ListaModValor = ListaModValor & ";" & ArrModelo(M) End If Next M ArrModVal = Split(ListaModValor, ";") ReDim ArrModelo(UBound(ArrModVal)) frmTabela.cbModelo.Clear For M = LBound(ArrModVal) To UBound(ArrModVal) frmTabela.cbModelo.AddItem ArrModVal(M) Next End Sub Private Sub cbmodelo_Change() Dim SomaDescricao As Long Dim D As Integer: Dim ArrDescVal As Variant: Dim ListaDescValor As String 'ATENÇÃO! se a coluna de sua planilha conter mais de 100 elementos aumente o valor d variavel "ArrDescricao" ReDim ArrDescricao(1000) vDesc = 0 SomaDescricao = vDesc + 2 If frmTabela.cbModelo.Text <> Empty Then Do While ActiveSheet.Range("A" & Trim(SomaDescricao)) <> Empty If ActiveSheet.Range("A" & Trim(SomaDescricao)) = frmTabela.cbAno.Text And _ ActiveSheet.Range("B" & Trim(SomaDescricao)) = frmTabela.cbModelo.Text And _ ActiveSheet.Range("C" & Trim(SomaDescricao)) <> Empty Then ArrDescricao(vDesc) = ActiveSheet.Range("C" & Trim(SomaDescricao)) vDesc = vDesc + 1 SomaDescricao = SomaDescricao + 1 Else SomaDescricao = SomaDescricao + 1 End If Loop End If For D = LBound(ArrDescricao) To UBound(ArrDescricao) - 1 If D = 0 Then ListaDescValor = ArrDescricao(D) Else If InStr(1, ListaDescValor, ArrDescricao(D)) = 0 Then ListaDescValor = ListaDescValor & ";" & ArrDescricao(D) End If Next D ArrDescVal = Split(ListaDescValor, ";") ReDim ArrDescricao(UBound(ArrDescVal)) frmTabela.cbDescricao.Clear For D = LBound(ArrDescVal) To UBound(ArrDescVal) frmTabela.cbDescricao.AddItem ArrDescVal(D) Next End Sub Private Sub cbdescricao_Change() Dim SomaCor As Long Dim C As Integer: Dim ArrCorVal As Variant: Dim ListaCorValor As String 'ATENÇÃO! se a coluna de sua planilha conter mais de 100 elementos aumente o valor d variavel "ArrCor" ReDim ArrCor(1000) vCor = 0 SomaCor = vCor + 2 If frmTabela.cbDescricao.Text <> Empty Then Do While ActiveSheet.Range("A" & Trim(SomaCor)) <> Empty If ActiveSheet.Range("A" & Trim(SomaCor)) = frmTabela.cbAno.Text And _ ActiveSheet.Range("B" & Trim(SomaCor)) = frmTabela.cbModelo.Text And _ ActiveSheet.Range("C" & Trim(SomaCor)) = frmTabela.cbDescricao.Text And _ ActiveSheet.Range("D" & Trim(SomaCor)) <> Empty Then ArrCor(vCor) = ActiveSheet.Range("D" & Trim(SomaCor)) vCor = vCor + 1 SomaCor = SomaCor + 1 Else SomaCor = SomaCor + 1 End If Loop End If For C = LBound(ArrCor) To UBound(ArrCor) - 1 If C = 0 Then ListaCorValor = ArrCor(C) Else If InStr(1, ListaCorValor, ArrCor(C)) = 0 Then ListaCorValor = ListaCorValor & ";" & ArrCor(C) End If Next C ArrCorVal = Split(ListaCorValor, ";") ReDim ArrCor(UBound(ArrCorVal)) frmTabela.cbCor.Clear For C = LBound(ArrCorVal) To UBound(ArrCorVal) frmTabela.cbCor.AddItem ArrCorVal(C) Next End Sub Private Sub cbcor_Change() Dim Linha As Long frmTabela.txtCodigo.Text = Empty Linha = 2 If frmTabela.cbCor.Text <> Empty Then Do While ActiveSheet.Range("A" & Trim(Linha)) <> Empty If ActiveSheet.Range("A" & Trim(Linha)) = frmTabela.cbAno.Text And _ ActiveSheet.Range("B" & Trim(Linha)) = frmTabela.cbModelo.Text And _ ActiveSheet.Range("C" & Trim(Linha)) = frmTabela.cbDescricao.Text And _ ActiveSheet.Range("D" & Trim(Linha)) = cbCor.Text And _ ActiveSheet.Range("E" & Trim(Linha)) <> Empty Then txtCodigo.Text = ActiveSheet.Range("E" & Trim(Linha)) End If Linha = Linha + 1 Loop Linha = o End If End Sub
Respostas
-
Pessoal fui testando os códigos e consegui acertar o local para fazer o que falei
Private Sub cbcor_Change()
Dim Linha As LongfrmTabela.txtCodigo.Text = Empty
Linha = 2
If frmTabela.cbCor.Text <> Empty Then
Do While ActiveSheet.Range("A" & Trim(Linha)) <> Empty
If ActiveSheet.Range("A" & Trim(Linha)) = frmTabela.cbAno.Text And _
ActiveSheet.Range("B" & Trim(Linha)) = frmTabela.cbModelo.Text And _
ActiveSheet.Range("C" & Trim(Linha)) = frmTabela.cbDescricao.Text And _
ActiveSheet.Range("D" & Trim(Linha)) = cbCor.Text And _
ActiveSheet.Range("E" & Trim(Linha)) <> Empty Then
txtCodigo.Text = ActiveSheet.Range("E" & Trim(Linha))
txtPreço.Text = ActiveSheet.Range("F" & Trim(Linha))
txtTempo.Text = ActiveSheet.Range("G" & Trim(Linha))
txtCódigoServiço.Text = ActiveSheet.Range("H" & Trim(Linha))
End If
Linha = Linha + 1
Loop
Linha = o
End If
End Subera so adicionar conforme o codigo acima. mas obrigado mais uma vez pela ajuda a todos
- Sugerido como Resposta Felipe Costa GualbertoMVP, Moderator sábado, 7 de junho de 2014 21:25
- Marcado como Resposta Felipe Costa GualbertoMVP, Moderator sábado, 7 de junho de 2014 21:25
Todas as Respostas
-
-
Felipe, em minha tabela o campo código é exclusivo para cada item, não existe duplicidade, vou explicar melhor:
suponhamos que um item tem as seguintes informações:
modelo descrição cor codigo preço serviço(TEMPO)
FILTROS FILTRO DO AR DO MOTOR PRETO 281133K200 R$61,50 0,6
Com o codigo acima, quando vou escolhendo as opções ate chegar na cor, quando clico na cor, o formulario lança pra mim o codigo "28113k200" em uma caixa de texto chamada código, o que estou querendo fazer é adicionar mais duas informações quando isso ocorrer, quero que ele informe nas outras caixas de texto o preço e na outra caixa de texto o tempo de serviço. Ou seja informar em 3 caixas de texto os resultados obtidos pelo ultimo filtro que foi "cor".onde os dados das caixas de texto se chamam:
codigo - txtCodigo
preço - txtPreço
serviço - txtServiçohttp://uploaded.to/file/gvfo5ehg
segue link do formulario
- Editado gustavo live quinta-feira, 7 de junho de 2012 17:15 incluido o formulario
-
Pessoal fui testando os códigos e consegui acertar o local para fazer o que falei
Private Sub cbcor_Change()
Dim Linha As LongfrmTabela.txtCodigo.Text = Empty
Linha = 2
If frmTabela.cbCor.Text <> Empty Then
Do While ActiveSheet.Range("A" & Trim(Linha)) <> Empty
If ActiveSheet.Range("A" & Trim(Linha)) = frmTabela.cbAno.Text And _
ActiveSheet.Range("B" & Trim(Linha)) = frmTabela.cbModelo.Text And _
ActiveSheet.Range("C" & Trim(Linha)) = frmTabela.cbDescricao.Text And _
ActiveSheet.Range("D" & Trim(Linha)) = cbCor.Text And _
ActiveSheet.Range("E" & Trim(Linha)) <> Empty Then
txtCodigo.Text = ActiveSheet.Range("E" & Trim(Linha))
txtPreço.Text = ActiveSheet.Range("F" & Trim(Linha))
txtTempo.Text = ActiveSheet.Range("G" & Trim(Linha))
txtCódigoServiço.Text = ActiveSheet.Range("H" & Trim(Linha))
End If
Linha = Linha + 1
Loop
Linha = o
End If
End Subera so adicionar conforme o codigo acima. mas obrigado mais uma vez pela ajuda a todos
- Sugerido como Resposta Felipe Costa GualbertoMVP, Moderator sábado, 7 de junho de 2014 21:25
- Marcado como Resposta Felipe Costa GualbertoMVP, Moderator sábado, 7 de junho de 2014 21:25