Jump to content

Recommended Posts

Posted

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.

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
Posted

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

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.

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

Create an account or sign in to comment

You need to be a member in order to leave a comment

Create an account

Sign up for a new account in our community. It's easy!

Register a new account

Sign in

Already have an account? Sign in here.

Sign In Now
×
×
  • Create New...

Important Information

By using this site you accept our Terms of Use and Privacy Policy. We have placed cookies on your device to help make this website better. You can adjust your cookie settings, otherwise we'll assume you're okay to continue.