XL 2016 Remplir dictionnary avec array

[BARNS]

Bonjour,

J'ai un array qui est généré par un code que je souhaite ordonner, enlever les doublons tout en réalisant un comptage.

On m'a suggéré d'utiliser un dictionnaire pour réaliser ce tri ce qui marche parfaitement avec des cellules données. Mais je souhaite bien transposer mon array directement dans le dictionnaire, et ici ca cloche un peu. Si quelqu'un peut m'aiguiller ca serait top

J'ai simplifié le problème que je rencontre avec l'excel joint et le code qui suit :

Code sans passer par l'array

Sub CompteItems()
  Set mondico = CreateObject("Scripting.Dictionary")
  For Each c In Range("a2", [a65000].End(xlUp))
    mondico(c.Value) = mondico(c.Value) + 1
  Next c
  [c2].Resize(mondico.Count, 1) = Application.Transpose(mondico.keys)
  [d2].Resize(mondico.Count, 1) = Application.Transpose(mondico.items)
  [C1].Sort Key1:=[C2], Order1:=xlAscending, Header:=xlYes
End Sub

En passant par l'array

Sub CompteItems()
Dim tabtube(8, 0)
For i = 1 To 8
 tabtube(i - 1, 0) = Cells(i + 1, 1)
Next i
Range("B2", "B10") = tabtube
  Set mondico = CreateObject("Scripting.Dictionary")
  For Each c LBound(tabtube, 2) To UBound(tabtube, 2)
    mondico(c.Value) = mondico(c.Value) + 1
  Next c
  [C2].Resize(mondico.Count, 1) = Application.Transpose(mondico.keys)
  [d2].Resize(mondico.Count, 1) = Application.Transpose(mondico.items)
  [C1].Sort Key1:=[C2], Order1:=xlAscending, Header:=xlYes
End Sub

Merci pour votre aide

 

[mapomme]

Bonjour @BARNS,

J'aurai plutôt codé:

Sub CompteItems2()
   Dim t, dic, i As Long
   t = Range("a2:a9")   'automatiquement un tableau t à deux dimensions de base 1, t contient les valeurs de la plage
   Set dic = CreateObject("Scripting.Dictionary")
   For i = 1 To UBound(t): dic(t(i, 1)) = dic(t(i, 1)) + 1: Next
   [C2].Resize(dic.Count) = Application.Transpose(dic.keys)
   [d2].Resize(dic.Count) = Application.Transpose(dic.items)
   [C2].Resize(dic.Count, 2).Sort Key1:=[C2], Order1:=xlAscending, Header:=xlNo
End Sub