[Resolvido] Ordem alfabética - script dictionary VBA

[mlcalves]

Bom dia Pessoal,

Podem ajudar-me por favor, preciso de ordenar os items dos meus dicionários de A a Z.

Obrigado.

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

[manuel antonio]

Bom dia, mlcalves.

Para ordenar dados eu utilizo esta rotibna que encontrei na net.

Ordena de forma crescente e decrescente.

Tenta adaptar ao teu caso.

Sub SortListBox(oLb As MSForms.ListBox, sCol As Integer, sType As Integer, sDir As Integer)
   Dim vaItems As Variant
   Dim i As Long, j As Long
   Dim c As Integer
   Dim vTemp As Variant

 'Put the items in a variant array
   vaItems = oLb.List

 'Sort the Array Alphabetically(1)
   If sType = 1 Then
    For i = LBound(vaItems, 1) To UBound(vaItems, 1) - 1
	    For j = i + 1 To UBound(vaItems, 1)
			 'Sort Ascending (1)
		    If sDir = 1 Then
			    If vaItems(i, sCol) > vaItems(j, sCol) Then
				    For c = 0 To oLb.ColumnCount - 1 'Allows sorting of multi-column ListBoxes
					    vTemp = vaItems(i, c)
					    vaItems(i, c) = vaItems(j, c)
					    vaItems(j, c) = vTemp
				    Next c
			    End If

				 'Sort Descending (2)
		    ElseIf sDir = 2 Then
			    If vaItems(i, sCol) < vaItems(j, sCol) Then
				    For c = 0 To oLb.ColumnCount - 1 'Allows sorting of multi-column ListBoxes
					    vTemp = vaItems(i, c)
					    vaItems(i, c) = vaItems(j, c)
					    vaItems(j, c) = vTemp
				    Next c
			    End If
		    End If

	    Next j
    Next i
	 'Sort the Array Numerically(2)
	 '(Substitute CInt with another conversion type (CLng, CDec, etc.) depending on type of numbers in the column)
   ElseIf sType = 2 Then
    For i = LBound(vaItems, 1) To UBound(vaItems, 1) - 1
	    For j = i + 1 To UBound(vaItems, 1)
			 'Sort Ascending (1)
		    If sDir = 1 Then
			    If CInt(vaItems(i, sCol)) > CInt(vaItems(j, sCol)) Then
				    For c = 0 To oLb.ColumnCount - 1 'Allows sorting of multi-column ListBoxes
					    vTemp = vaItems(i, c)
					    vaItems(i, c) = vaItems(j, c)
					    vaItems(j, c) = vTemp
				    Next c
			    End If

				 'Sort Descending (2)
		    ElseIf sDir = 2 Then
			    If CInt(vaItems(i, sCol)) < CInt(vaItems(j, sCol)) Then
				    For c = 0 To oLb.ColumnCount - 1 'Allows sorting of multi-column ListBoxes
					    vTemp = vaItems(i, c)
					    vaItems(i, c) = vaItems(j, c)
					    vaItems(j, c) = vTemp
				    Next c
			    End If
		    End If

	    Next j
    Next i
   End If

 'Set the list to the array
   oLb.List = vaItems
End Sub

Abraços.

M.A.

[mlcalves]

Boa tarde pessoal,

Resolvi da seguinte forma:

Private Sub Worksheet_Activate()
Dim r
Dim Dict As Scripting.Dictionary
Dim Dict2 As Scripting.Dictionary
Dim Arr() As Variant
Dim Arr2() As Variant
Dim Temp1 As Variant
Dim Temp2 As Variant
Dim Txt As String
Dim i As Long
Dim j As Long

'###### Carregar Combobox Função Operação
'Cria instância do dicionário
Set Dict = New Dictionary
'Definir o modo de comparação
Dict.CompareMode = TextCompare
With Sheets("Combobox")
	 Dict.Add " ", Nothing
	 For Each r In .Range("B2", .Range("B65536").End(xlUp))
			 If Not IsEmpty(r) And Not Dict.exists(r.Value) Then
					 Dict.Add r.Value, Nothing
			 End If
	 Next
End With
'Allocate storage space for the dynamic array
   ReDim Arr(0 To Dict.Count - 1, 0 To 2)

   'Fill the array with the keys and items from the Dictionary
   For i = 0 To Dict.Count - 1
    Arr(i, 0) = Dict.Keys(i)
    'Arr(i, 1) = Dict.Items(i)
   Next i

   'Sort the array using the bubble sort method
   For i = LBound(Arr, 1) To UBound(Arr, 1) - 1
    For j = i + 1 To UBound(Arr, 1)
	    If Arr(i, 0) > Arr(j, 0) Then
		    Temp1 = Arr(j, 0)
		    Temp2 = Arr(j, 1)
		    Arr(j, 0) = Arr(i, 0)
		    Arr(j, 1) = Arr(i, 1)
		    Arr(i, 0) = Temp1
		    Arr(i, 1) = Temp2
	    End If
    Next j
   Next i

   'Clear the Dictionary
   Dict.RemoveAll

   'Add the sorted keys and items from the array back to the Dictionary
   For i = LBound(Arr, 1) To UBound(Arr, 1)
    Dict.Add Key:=Arr(i, 0), Item:=Arr(i, 1)
   Next i

   'Build a list of keys and items from the Dictionary
   For i = 0 To Dict.Count - 1
   Next i




Me.ComboBox1.List = Dict.Keys
'###### Carregar Combobox Função
'Limpa as variáveis
i = 0
j = 0
Temp1 = ""
Temp2 = ""
'Cria instância do dicionário
Set Dict2 = New Dictionary
'Definir o modo de comparação
Dict.CompareMode = TextCompare
With Sheets("Combobox")
	 Dict2.Add " ", Nothing
	 For Each r In .Range("C2", .Range("C65536").End(xlUp))
			 If Not IsEmpty(r) And Not Dict2.exists(r.Value) Then
					 Dict2.Add r.Value, Nothing
			 End If
	 Next
End With
'Allocate storage space for the dynamic array
   ReDim Arr2(0 To Dict2.Count - 1, 0 To 2)

   'Fill the array with the keys and items from the Dictionary
   For i = 0 To Dict2.Count - 1
    Arr2(i, 0) = Dict2.Keys(i)
    'Arr2(i, 1) = Dict2.Items(i)
   Next i

   'Sort the array using the bubble sort method
   For i = LBound(Arr2, 1) To UBound(Arr2, 1) - 1
    For j = i + 1 To UBound(Arr2, 1)
	    If Arr2(i, 0) > Arr2(j, 0) Then
		    Temp1 = Arr2(j, 0)
		    Temp2 = Arr2(j, 1)
		    Arr2(j, 0) = Arr2(i, 0)
		    Arr2(j, 1) = Arr2(i, 1)
		    Arr2(i, 0) = Temp1
		    Arr2(i, 1) = Temp2
	    End If
    Next j
   Next i

   'Clear the Dictionary
   Dict2.RemoveAll

   'Add the sorted keys and items from the array back to the Dictionary
   For i = LBound(Arr2, 1) To UBound(Arr2, 1)
    Dict2.Add Key:=Arr2(i, 0), Item:=Arr2(i, 1)
   Next i

   'Build a list of keys and items from the Dictionary
   For i = 0 To Dict2.Count - 1
   Next i

Me.ComboBox2.List = Dict2.Keys