Ajuda - Ligação de combobox - script dictionary

mlcalves · Fev 12, 2014

Boa tarde pessoal,

Estou aqui com uma dúvida.

EU tenho uma sheet em excel em que tenho 3 combobox.

Acontece que quero que a combobox3 (Utilizadores) preencha os dados conforme o que for selecionado na combobox1 (função) ou combobox2 (departamento).

Acontece que só uma é selecionada (cbo1 ou cbo2)

com o código abaixo, consigo que ao selecionar a combobox1, a combobox3 seja populada com os dados que quero. Mas quero também que ao selecionar a combobox2 seja feita a mesma ação.

É possível na sheet ComboboxFunçãoOP, eu ter as 3 colunas com os dados da comboboxs (Função, departamento, Utilizadores) ?

Já tentei acrescentar código mas sem sucesso por isso deixei apenas os dados que ao escolher valor da combobox1, define a source para a combobox3

Agradeço a vossa ajuda.

Obrigado.

Código:

Option Explicit

Private dic As Object


Private Sub Worksheet_Activate()
Dim x, r

Set dic = CreateObject("Scripting.Dictionary")
With Sheets("ComboboxFunçãoOP")
         For Each r In .Range("A2", .Range("A65536").End(xlUp))
                 If Not IsEmpty(r) And Not dic.exists(r.Value) Then
                         dic.Add r.Value, Nothing
                 End If
         Next
End With
x = dic.keys
Me.ComboBox1.List = x



End Sub

Private Sub ComboBox1_Change()
Dim a, i As Long, y
With Sheets("ComboboxFunçãoOP")
         a = .Range("a2").CurrentRegion.Resize(, 2)
End With
With CreateObject("scripting.dictionary")
         .comparemode = vbTextCompare
         For i = 2 To UBound(a, 1)
                 If Not IsEmpty(a(i, 1)) And Me.ComboBox1 = a(i, 1) Then
                         If Not .exists(a(i, 2)) Then .Add a(i, 2), Nothing
                 End If
         Next
         y = .keys
         With Me.ComboBox3
                 .Clear
                 .List = Application.Transpose(y)
         End With
End With
End Sub

mlcalves · Fev 18, 2014

Pessoal ficou a funcionar (com a ajuda de um amigo) da seguinte forma:

Código:

Private Sub Worksheet_Activate()
Dim r

Set dic = CreateObject("Scripting.Dictionary")
With Sheets("Combobox")
dic.Add " ", Nothing
For Each r In .Range("B2", .Range("B65536").End(xlUp))
If Not IsEmpty(r) And Not dic.exists(r.Value) Then
dic.Add r.Value, Nothing
End If
Next
End With
Me.ComboBox1.List = dic.keys

Set dic2 = CreateObject("Scripting.Dictionary")
With Sheets("Combobox")
dic2.Add " ", Nothing
For Each r In .Range("C2", .Range("C65536").End(xlUp))
If Not IsEmpty(r) And Not dic2.exists(r.Value) Then
dic2.Add r.Value, Nothing
End If
Next
End With
Me.ComboBox2.List = dic2.keys

End Sub

Private Sub ComboBox1_Change()
Call Filter
End Sub

Private Sub ComboBox2_Change()
Call Filter
End Sub

Private Sub Filter()
Dim a, b, i As Long, y

With Sheets("Combobox")
a = .Range("B2", .Range("B65536").End(xlUp))
End With

With Sheets("Combobox")
b = .Range("C2", .Range("C65536").End(xlUp))
End With

With Sheets("Combobox")
c = .Range("D2", .Range("D65536").End(xlUp))
End With


With CreateObject("scripting.dictionary")
.comparemode = vbTextCompare
For i = 1 To UBound(a, 1)
If Me.ComboBox1.Text = CStr(a(i, 1)) And Me.ComboBox2.Text = CStr(b(i, 1)) Or Me.ComboBox1.Text = CStr(a(i, 1)) And Me.ComboBox2.Text = " " Or Me.ComboBox2.Text = CStr(b(i, 1)) And Me.ComboBox1.Text = " " Then
If Not .exists(c(i, 1)) Then .Add c(i, 1), Nothing
End If
Next

y = .keys
If .Count > 0 Then
With Me.ComboBox3
.Clear
.List = Application.Transpose(y)
End With

Else
Me.ComboBox3.Clear

End If

End With
End Sub

e meti também para sempre que o livro for aberto, for selecionado a sheet combobox (onde tenho as sources das combo) para preencher as combo's.

Código:

Private Sub Workbook_Open()
Application.ScreenUpdating = False 'Para não mostrar os seguintes movimentos
Sheets("Combobox").Select
Sheets("Geral").Select
End Sub

Ajuda - Ligação de combobox - script dictionary

mlcalves

GF Ouro

mlcalves

GF Ouro