XL 2016 Remplir dictionnary avec array

BARNS · 16 Juillet 2021

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

Code:

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

VB:

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 · 16 Juillet 2021

Bonjour @BARNS,

J'aurai plutôt codé:

Code:

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

XL 2016 Remplir dictionnary avec array

BARNS

XLDnaute Junior

Pièces jointes

mapomme

XLDnaute Barbatruc

Discussions similaires