none
Como usar a combobox como filtro e após a escolha visualizar o resultado em uma caixa de texto RRS feed

  • Pergunta

  • Como usar a combobox como filtro e após a escolha visualizar o resultado em uma caixa de texto

    Olá

    Pessoal estou montando um formulario onde gostaria de utilizar 4 combobox como filtro e após isso receber o resultado desse filtro em um textbox

    cheguei a montar o formulario mas nao sei como colocar os filtros nos combobox, vou dar uma explicada como estou criando:

    cboAno = Coluna A -  filtrar as informações nesta coluna independente da quantidade

    cboModelo = Coluna B - usar as opções filtradas pelo filtro acima e escolher o modelo, pois o ano escolhi acima

    cboDescrição = Coluna C - usar as opções filtradas (Ano,Modelo) e escolhe o item que desejo o código

    cboCor = Coluna D -  Ja definidos pelos filtros acima(ANO,MODELO,Descrição) escolher a cor o item

    txtCodigo = Coluna E - quando clicar no ultimo filtro "Cor" informar o código cadastrado na linha filtrada com os filtros acima

    Por favor me ajudem estou quebrando a cabeça, a dias sem resultados, segue abaixo meu codigo:


    Private Sub cboAno_Click()

    End Sub

    Private Sub cboCor_Click()

    End Sub

    Private Sub cboDescrição_Click()

    End Sub

    Private Sub cboModelo_Click()

    End Sub

    Private Sub txtCodigo_Change()

    End Sub

    quarta-feira, 25 de abril de 2012 02:08

Respostas

Todas as Respostas

  • Bom dia,

    As informações que deseja filtrar esta no Excel ou Banco de dados?

    Você esta usando Forms?

    quarta-feira, 25 de abril de 2012 12:47
  • Olá boa noite,

    Desculpe a demora so anoite que tenho tempo, dia corrido hoje, primeiramente, gostaria de agradecer a ajuda viu. Vamos la meu projeto esta em uma planilha do excell segue em anexo os dados pra vc dar uma olhada.

    quinta-feira, 26 de abril de 2012 02:13
  • Boa noite!

    Segue código abaixo:

    'Em 1º lugar declare no modulo: "Public Linha As Integer"
    
    Private Sub UserForm_Initialize()
        Sheets("Tabela").Select
        Sheets("Tabela").Activate
    
        cbano.Clear
        
        Linha = 2
        Do While ActiveSheet.Range("A" & Trim(Linha)) <> Empty
        
            cbano.AddItem ActiveSheet.Range("A" & Trim(Linha))
            
            Linha = Linha + 1
        Loop
        Linha = 0
    End Sub
         
    Private Sub cbano_Change()
    
        cbmodelo.Clear
        
        Linha = 2
        If cbano.Text <> Empty Then
            Do While ActiveSheet.Range("A" & Trim(Linha)) <> Empty
                If ActiveSheet.Range("A" & Trim(Linha)) = cbano.Text Then
                    If ActiveSheet.Range("B" & Trim(Linha)) <> Empty Then
                        cbmodelo.AddItem ActiveSheet.Range("B" & Trim(Linha))
                    End If
                End If
                Linha = Linha + 1
            Loop
        End If
        Linha = 0
    End Sub
    
    Private Sub cbmodelo_Change()
    
        cbdesc.Clear
        
        Linha = 2
        If cbmodelo.Text <> Empty Then
            Do While ActiveSheet.Range("A" & Trim(Linha)) <> Empty
                If ActiveSheet.Range("A" & Trim(Linha)) = cbano.Text And ActiveSheet.Range("B" & Trim(Linha)) = cbmodelo.Text Then
                    If ActiveSheet.Range("C" & Trim(Linha)) <> Empty Then
                        cbdesc.AddItem ActiveSheet.Range("C" & Trim(Linha))
                    End If
                End If
                Linha = Linha + 1
            Loop
        End If
        Linha = 0
    End Sub
    
    Private Sub cbdesc_Change()
    
        cbcor.Clear
        
        Linha = 2
        If cbdesc.Text <> Empty Then
            Do While ActiveSheet.Range("A" & Trim(Linha)) <> Empty
                If ActiveSheet.Range("A" & Trim(Linha)) = cbano.Text And ActiveSheet.Range("B" & Trim(Linha)) = cbmodelo.Text And ActiveSheet.Range("C" & Trim(Linha)) = cbdesc.Text Then
                    If ActiveSheet.Range("D" & Trim(Linha)) <> Empty Then
                        cbcor.AddItem ActiveSheet.Range("D" & Trim(Linha))
                    End If
                End If
                Linha = Linha + 1
            Loop
        End If
        Linha = 0
    End Sub
    
    Private Sub cbcor_Change()
    
        txtcodigo.Text = Empty
        
        Linha = 2
        If cbcor.Text <> Empty Then
            Do While ActiveSheet.Range("A" & Trim(Linha)) <> Empty
                If ActiveSheet.Range("A" & Trim(Linha)) = cbano.Text And ActiveSheet.Range("B" & Trim(Linha)) = cbmodelo.Text And ActiveSheet.Range("C" & Trim(Linha)) = cbdesc.Text And ActiveSheet.Range("D" & Trim(Linha)) = cbcor.Text Then
                    If ActiveSheet.Range("E" & Trim(Linha)) <> Empty Then
                        txtcodigo.Text = ActiveSheet.Range("E" & Trim(Linha))
                    End If
                End If
                Linha = Linha + 1
            Loop
        End If
        Linha = o
    End Sub
    
    

    Qualquer duvida é só postar.

    At.

    Reinaldo dos Santos


    quinta-feira, 26 de abril de 2012 23:45
  • Olá Reinaldo,

    vi que o codigo nao é simples, mas lancei conforme informado e deu um erro na hora de iniciar o formulario, fiz uma depuração para mostrar onde esta localizado os erros, tbem modifiquei o nome dos combobox confomre consta no se codigo, segue abaixo as fotos para pode analisar melhor.

    sexta-feira, 27 de abril de 2012 01:33
  • Olá Reinaldo,

    vi que o codigo nao é simples, mas lancei conforme informado e deu um erro na hora de iniciar o formulario, fiz uma depuração para mostrar onde esta localizado os erros, tbem modifiquei o nome dos combobox confomre consta no se codigo, segue abaixo as fotos para pode analisar melhor.

    resumidamente, o erro ta aparecendo nesta parte:

    Private Sub UserForm_Initialize()
        Sheets("Tabela").Select
        Sheets("Tabela").Activate

        cbAno.Clear

    sexta-feira, 27 de abril de 2012 01:35
  • Meu caro, manda esse arquivo no meu e-mail para eu verificar.

    reinaldo.santos@live.com

    At.

    Reinaldo 

    sexta-feira, 27 de abril de 2012 02:06
  • Mandei um email pra vc,

    meu email é: gustavo@motobrazhonda.com.br

    sexta-feira, 27 de abril de 2012 20:42
  • Boa tarde!

    Gustavo,

    Mandei ontem no seu e-mail, porém vou mostrar aqui para as pessoas que terem a mesma duvida:

    'Em um modulo, declarei 4 arrays Public vAno As Long Public ArrAno() As Variant Public vMod As Long Public ArrModelo() As Variant Public vDesc As Long Public ArrDescricao() As Variant Public vCor As Long Public ArrCor() As Variant 'No formulário Tabela escrevi as rotinas conforme abaixo: 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(100) 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

    'Eliminando os valores duplicados 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))

    'Carregando a Combobox "Ano" frmTabela.cbAno.Clear For A = LBound(ArrAnoVal) To UBound(ArrAnoVal) frmTabela.cbAno.AddItem ArrAnoVal(A) Next End Sub

    ' A diferença nas demais rotinas é o Teste logico para adicionar dados da planilha e os Array!

    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(100) vMod = 0 SomaModelo = vMod + 2

    'Teste logico para adicionar dados da planilha

    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(100) vDesc = 0 SomaDescricao = vDesc + 2

    'Teste logico para adicionar dados da planilha

    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(100) vCor = 0 SomaCor = vCor + 2

    'Teste logico para adicionar dados da planilha

    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

    'Teste logico para adicionar dados da planilha

    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

    OBS. Não sou um "Programador", mas como seu programa não é muito pesado (grande) fica perfeito.

    At.

    Reinaldo dos Santos



    domingo, 29 de abril de 2012 18:43
  • Mas esclarecedor do que o código seria o arquivo. Por favor, postem o arquivo...

    jose

    terça-feira, 1 de maio de 2012 02:37
  • Olá,

    Poste o arquivo de BD de exemplo.


    Felipe Costa Gualberto - http://www.ambienteoffice.com.br

    terça-feira, 1 de maio de 2012 19:01
    Moderador
  • Zenga,

    Favor postar o arquivo...


    jose

    quinta-feira, 3 de maio de 2012 23:55
  • 

    Boa noite.

    JoséA,

    segue link: http://www.4shared.com/file/ZL8iu3oG/Programa_atualizado.html?

    Execute a macro e vá em tabela de cores...

    desculpe a demora.

    At.

    Reinaldo dos Santos


    terça-feira, 8 de maio de 2012 01:47
  • Veja um exemplo pronto em: https://skydrive.live.com/redir.aspx?cid=fb206a2d510e0661&resid=FB206A2D510E0661!368&parid=FB206A2D510E0661!275.

    Com base neste exemplo, monte seus outros formulários.

    Recomendo fortemente ler, antes de estudar o código, a página: http://www.ambienteoffice.com.br/excel/filtrar_dados_em_formularios/.


    Felipe Costa Gualberto - http://www.ambienteoffice.com.br

    segunda-feira, 14 de maio de 2012 00:29
    Moderador