Ajuda com validação de dados condicionada e procv

Mensagens : 42 Data de inscrição : 24/07/2014 Localização : Coimbra

Bom dia.

Deu para perceber o que pretendo?

Obrigado.

Mensagens : 1820 Data de inscrição : 13/07/2011 Localização : Serra - ES

Bom dia!!

Eu não tenho permissão de baixar e postar arquivos em sites de hospedagens, não tenho acesso ao meu email particular, no meu trampo, após sair do trampo, vou para a faculdade e chego muito tarde em casa (salvo quando não tem aula, ou final de semana).

Faça o seguinte, abra um arquivo novo, insira um userforme, adicione 3 comboboxs (cbx1, cbx2, cbx3).

Cole o código dentro.

Código:: Option Explicit

Private Sub UserForm_Initialize()
AddFruit Range([A1], [A1].End(xlDown))
cbx1.ListIndex = 0
End Sub

Sub AddFruit(Data As Range)
Dim d, cel As Range
Set d = CreateObject("Scripting.Dictionary")
For Each cel In Data
On Error Resume Next
d.Add cel.Text, cel.Text
Next
cbx1.List() = d.items
End Sub

'********************************
Private Sub cbx1_Change()
cbx2.Clear
AddType Range([B1], [B1].End(xlDown))
cbx2.ListIndex = 0
cbx3.ListIndex = 0
End Sub

Sub AddType(Data As Range)
Dim d, cel As Range
Set d = CreateObject("Scripting.Dictionary")
For Each cel In Data
If cel.Offset(, -1) = cbx1 Then
On Error Resume Next
d.Add cel.Text, cel.Text
End If
Next
cbx2.List() = d.items
End Sub

'********************************
Private Sub cbx2_Change()
cbx3.Clear
AddMake Range([C1], [C1].End(xlDown))
If cbx2 <> "" Then cbx3.ListIndex = 0
End Sub

Sub AddMake(Data As Range)
Dim d, cel As Range
Set d = CreateObject("Scripting.Dictionary")
For Each cel In Data
If cel.Offset(, -1) = cbx2 Then
On Error Resume Next
d.Add cel.Text, cel.Text
End If
Next
cbx3.List() = d.items
End Sub

Considere essa lista em colunaA, B, C.

Citação :: Local Familia Equipmento
leste Tip1 Alicates
leste Tip1 Calibre de raios, lâminas e roscas
leste Tip1 Chave de fenda
leste Tip1 Chave de fenda
leste Tip2 Cabo de força
leste Tip3 Catraca
leste Tip3 Chave em L
norte Tip1 Chave estrela
norte Tip1 Chave Torx
norte Tip1 Chave Torx
norte Tip1 Cocinetes para rocas externas
norte Tip2 Chave hexagonais (Allen)
norte Tip2 Desandador
norte Tip3 Chaves combinadas
sul Tip1 Goniômetro para torque ângulo
sul Tip1 Manômetros
sul Tip1 Paquímetros
sul Tip2 Manivela
sul Tip2 Micrometros
sul Tip3 Macho para roscas internas
sul Tip3 Martelos em geral
oeste Tip1 Manômetros
oeste Tip1 Soquetes
oeste Tip1 Torquímetros
oeste Tip2 Alicates
oeste Tip3 Chave de Boca
oeste Tip3 Chave estrela
oeste Tip3 Chave estrela

faça os testes!

Att

Mensagens : 42 Data de inscrição : 24/07/2014 Localização : Coimbra

Já fiz alguns testes, mas ainda não consegui o que pretendo, partindo do exemplo que deste, se eu escolher o Norte, e tip1, nos equipamento aparece-me todos os equipamentos tip1 independentemente do seu local.

Ou seja o local não condiciona a escolha do equipamento.

Mensagens : 1820 Data de inscrição : 13/07/2011 Localização : Serra - ES

Bom dia!!

Eu vou tirar um tempo e tentar ajustar esse detalhe.... scratch

Att

Mensagens : 42 Data de inscrição : 24/07/2014 Localização : Coimbra

Obrigado mesmo.

Mensagens : 42 Data de inscrição : 24/07/2014 Localização : Coimbra

Caso o anexo não esteja disponível manda mens privada que recebo notificação no email.

Mais uma vez obrigado.

Mensagens : 1820 Data de inscrição : 13/07/2011 Localização : Serra - ES

Boa tarde!!

Veja se ajuda.

Código:: Option Explicit
Private Sub CommandButton1_Click()
Unload UserForm1
End Sub

Código:: Private Sub UserForm_Initialize()
AddMake Range([A2], [A2].End(xlDown))
End Sub

Código:: Sub AddMake(Data As Range)
   Dim d, cel As Range
   Set d = CreateObject("Scripting.Dictionary")
   For Each cel In Data
   On Error Resume Next
   d.Add cel.Text, cel.Text
   Next
   ComboBox1.List() = d.items
End Sub

Código:: Private Sub ComboBox1_Change()
   ComboBox2.Clear

   AddModel Range([B2], [B2].End(xlDown))
End Sub
Sub AddModel(Data As Range)
   Dim d, cel As Range
   Set d = CreateObject("Scripting.Dictionary")
   For Each cel In Data
   If cel.Offset(, -1) = ComboBox1.Text Then
   On Error Resume Next
   d.Add cel.Text, cel.Text
   End If
   Next
   ComboBox2.List() = d.items
End Sub

Código:: Private Sub ComboBox2_Change()
ComboBox3.Clear
AddYear Range([C2], [C2].End(xlDown))
End Sub

Código:: Sub AddYear(Data As Range)
   Dim d, cel As Range
   Set d = CreateObject("Scripting.Dictionary")
   For Each cel In Data
   If cel.Offset(, -1) = ComboBox2.Text And cel.Offset(, -2).Text = ComboBox1.Text Then
   On Error Resume Next
   d.Add cel.Text, cel.Text
   End If
   Next
   ComboBox3.List() = d.items
End Sub

Código:: Private Sub ComboBox3_Change()
ComboBox4.Clear
AddExtras Range([D2], [D2].End(xlDown))
End Sub

Código:: Sub AddExtras(Data As Range)
   Dim d, cel As Range
   Set d = CreateObject("Scripting.Dictionary")
   For Each cel In Data
   If cel.Offset(, -1) = ComboBox3.Text And cel.Offset(, -2) = ComboBox2.Text _
   And cel.Offset(, -3) = ComboBox1.Text Then
   On Error Resume Next
   d.Add cel.Text, cel.Text
   End If
   Next
   ComboBox4.List() = d.items
End Sub

Código:: Private Sub ComboBox4_Change()
ComboBox5.Clear
AddValue Range([E2], [E2].End(xlDown))
End Sub

Código:: Sub AddValue(Data As Range)
   Dim d, cel As Range
   Set d = CreateObject("Scripting.Dictionary")
   For Each cel In Data
   If cel.Offset(, -1) = ComboBox4.Text And cel.Offset(, -2) = ComboBox3.Text _
   And cel.Offset(, -3) = ComboBox2.Text And cel.Offset(, -4) = ComboBox1.Text Then
   On Error Resume Next
   d.Add cel.Text, cel.Text
   End If
   Next
   ComboBox5.List() = d.items
   ListBox1.List() = d.items
   End Sub

Att

Mensagens : 42 Data de inscrição : 24/07/2014 Localização : Coimbra

Bom dia.

Não percebi no codigo o facto de teres combbox 4 e 5?

Mensagens : 1820 Data de inscrição : 13/07/2011 Localização : Serra - ES

Bom dia!!

Então retire as!!!!!!

Att

Mensagens : 42 Data de inscrição : 24/07/2014 Localização : Coimbra

Retirando os codigos da combbox 4 e 5, não funciona...

Mensagens : 1820 Data de inscrição : 13/07/2011 Localização : Serra - ES

Bom dia!!

tem como eu te mandar um arquivo via email?

me passe seu email via MP

Att

Mensagens : 1820 Data de inscrição : 13/07/2011 Localização : Serra - ES

Bom dia!!

faça assim..

Em um arquivo em branco, adicione o Userform, mais 3 combobox.
nome do fórmulario:UserForm1
nome da combobox1:cbx1
nome da combobox2:cbx2
nome da combobox3:cbx3
Em uma guia do excel (Plan1), insira os dados.

Citação :: Local Familia Equipmento
leste Tip1 Alicates
leste Tip1 Calibre de raios, lâminas e roscas
leste Tip1 Chave de fenda
leste Tip1 Chave de fenda
leste Tip2 Cabo de força
leste Tip3 Catraca
leste Tip3 Chave em L
norte Tip1 Chave estrela
norte Tip1 Chave Torx
norte Tip1 Chave Torx
norte Tip1 Cocinetes para rocas externas
norte Tip2 Chave hexagonais (Allen)
norte Tip2 Desandador
norte Tip3 Chaves combinadas
sul Tip1 Goniômetro para torque ângulo
sul Tip1 Manômetros
sul Tip1 Paquímetros
sul Tip2 Manivela
sul Tip2 Micrometros
sul Tip3 Macho para roscas internas
sul Tip3 Martelos em geral
oeste Tip1 Manômetros
oeste Tip1 Soquetes
oeste Tip1 Torquímetros
oeste Tip2 Alicates
oeste Tip3 Chave de Boca
oeste Tip3 Chave estrela
oeste Tip3 Chave estrela

Código....

Código:: Option Explicit

Private Sub UserForm_Initialize()
AddLocal Range([A1], [A1].End(xlDown))
cbx1.ListIndex = 0
End Sub

Sub AddLocal(Data As Range)
Dim d, cel As Range
Set d = CreateObject("Scripting.Dictionary")
For Each cel In Data
On Error Resume Next
d.Add cel.Text, cel.Text
Next
cbx1.List() = d.items
End Sub

'***Combobox1 e subrotina***
Private Sub cbx1_Change()
cbx2.Clear
AddFamilia Range([B1], [B1].End(xlDown))
cbx2.ListIndex = 0
cbx3.ListIndex = 0
End Sub

Sub AddFamilia(Data As Range)
Dim d, cel As Range
Set d = CreateObject("Scripting.Dictionary")
For Each cel In Data
If cel.Offset(, -1) = cbx1 Then
On Error Resume Next
d.Add cel.Text, cel.Text
End If
Next
cbx2.List() = d.items
End Sub

'***Combobox2 e subrotina***
Private Sub cbx2_Change()
cbx3.Clear
AddEquipamento Range([C1], [C1].End(xlDown))
If cbx2 <> "" Then cbx3.ListIndex = 0
End Sub
Sub AddEquipamento(Data As Range)
Dim d, cel As Range
Set d = CreateObject("Scripting.Dictionary")
For Each cel In Data
If cel.Offset(, -1) = cbx2 And cel.Offset(0, -2) = cbx1 Then
On Error Resume Next
d.Add cel.Text, cel.Text
End If
Next
cbx3.List() = d.items
End Sub

Att

Mensagens : 42 Data de inscrição : 24/07/2014 Localização : Coimbra

Ja enviei mens privada com o email.

Mensagens : 1820 Data de inscrição : 13/07/2011 Localização : Serra - ES

Bom dia!!
Com o exemplo que eu postei, você pode adaptar!

Veja seu email!!

Att

Mensagens : 1820 Data de inscrição : 13/07/2011 Localização : Serra - ES

Boa tarde!!

Por gentileza, poste as dúvidas no fórum!

Eu postei algo próximo do que deseja em:
http://www.planilhando.com.br/forum/viewtopic.php?f=23&t=13092

Att

Mensagens : 42 Data de inscrição : 24/07/2014 Localização : Coimbra

Pode postar aqui o exemplo que serviu de base para fazer o codigo, não tenho acesso a ver os anexos.

Obrigado

Mensagens : 42 Data de inscrição : 24/07/2014 Localização : Coimbra

Já tentei registar-me no forum, mas não consigo, não recebo o email de activação..

Daí pedir, se possível enviar o anexo que serviu de base para tirar a duvida.

Assunto: Não estou a conseguir Qui Out 09, 2014 1:59 pm

Pegando no exemplo que me aconselhou não estou a conseguir, pois não sei como condicionar o preenchimento das TEXTBOX com o que escolho nas 3 COMBOBOX.

Segue em anexo o modelo como se encontra.
https://w*w*w.sen*ds*pace.*com/file/53yphh

Mensagens : 42 Data de inscrição : 24/07/2014 Localização : Coimbra

Apesar de ter tentado de varias formas não consegui preencher as TEXTBOX

Se poder ajudar a preencher só uma condicionada pela 3 escolhas que faço nas CombBox, que essas já consegui por a funcionar...

Mensagens : 1820 Data de inscrição : 13/07/2011 Localização : Serra - ES

Boa tarde!

Bruno, aqui no trampo eu tempo mais tempo, mas eu não consigo baixar o arquivo, faça me lembra no final de semana, minhas chances são maiores.

Att

Mensagens : 42 Data de inscrição : 24/07/2014 Localização : Coimbra

OK.

Obrigado.

Amanha volto a postar aqui o arquivo para dares uma vista de olhos.

Obrigado mais uma vez.

Mensagens : 42 Data de inscrição : 24/07/2014 Localização : Coimbra

Bom dia.

Lamentavelmente estive sem computador no fim de semana, e não consegui enviar novamente o arquivo.

Quando poder, eu volto a postar aqui o arquivo.

Obrigado.

Mensagens : 42 Data de inscrição : 24/07/2014 Localização : Coimbra

Quando poder baixar o arquivo eu volto a por aqui.

É só avisar-me.

Mais uma vez obrigado.

Mensagens : 42 Data de inscrição : 24/07/2014 Localização : Coimbra

É possível dar uma vista de olhos este fim de semana?

Deixo aqui o arquivo

https://*w*w*w*.send*space.*com*/file*/xca0oa

Obrigado

Mensagens : 1820 Data de inscrição : 13/07/2011 Localização : Serra - ES

Boa noite!!!!

Eu fiz de uma forma bem primitiva...
https://www.sendspace.com/file/g1cere

Att

» Ajuda! Gravar dados da célula e compara-lo com dados Atuais.
» Validação de Dados
» validação de dados
» DADOS VALIDAÇÃO
» Validação de Dados