Accueil

Liste sans doublons pour combobox MAC
Liste sans doublons 2 colonnes
Collection sans doublons triée
Tableau comme élément d'une collection
Simulation de Dictionary pour Excel Mac

Une Collection est un ensemble d'éléments.

Collection

Dim variable AS New Collection
Variable.Add item:=valeur

Sub EssaiCollection()
  Dim MaListe As New Collection
  MaListe.Add "Dupont"
  MaListe.Add "Martin"
  MaListe.Add "Zoe"
  For i = 1 To MaListe.Count
    Cells(i, 4) = MaListe(i)
  Next i
  Set MaListe = Nothing
End Sub

MaCollec.Add item:=valeur,Key:=clé
MaCollec.Remove item:=index
retourItem=MaCollec(clé)

Avec l’option Key, on peut interdire les doublons dans une collection.

Sub CollectionSansDoublons()
  Dim MaListe As New Collection
  On Error Resume Next
  MaListe.Add Item:="1111", Key:="Dupont"
  MaListe.Add Item:="2222", Key:="Durand"
  MaListe.Add Item:="3333", Key:="Martin"
  MaListe.Add Item:="4444", Key:="Martin"
  MaListe.Remove 2
  For i = 1 To MaListe.Count
    Cells(i, 5) = MaListe(i)
  Next i
  tmp = MaListe("Dupont")       ' Accès par une clé
  MsgBox tmp
  Set MaListe = Nothing
End Sub

Ci dessous, nous créons une collection sans doublons. Le temps est de 10 secondes (0,25 avec Dictionary)

Sub CollectionSansDoublons()
   Dim t, i As Long, n As Long, temp As Long
   t = Timer()
   Dim Maliste As New Collection
   On Error Resume Next
   n = 40000
   For i = 1 To n
     temp = Int(Rnd * n)
     Maliste.Add Item:=temp, key:=CStr(temp)
   Next i
   On Error GoTo 0
   Dim a()
   ReDim a(1 To n)
   For i = 1 To Maliste.Count
     a(i) = Maliste(i)
   Next i
   [a2].Resize(Maliste.Count) = Application.Transpose(a)
   MsgBox Timer() - t ' 10 sec
End Sub

Donne la liste sans doublons de la colonne A

SansDoublonsCollectionMAC

Sub SansDoublonsCollection()
  Dim Collec1 As New Collection
  a = Range([a2], [a65000].End(xlUp))
  On Error Resume Next
  For Each c In a
    Collec1.Add Item:=c, Key:=c
  Next c
  On Error GoTo 0
  Dim b(): ReDim b(1 To Collec1.Count)
  For i = 1 To Collec1.Count
     b(i) = Collec1(i)
  Next i
  [c2].Resize(Collec1.Count) = Application.Transpose(b)
End Sub

Liste sans doublons pour ComboBox pour MAC

Sur MAC, Dictionary n'existe pas. Pour obtenir une liste sans doublons pour un ComboBox , utiliser Collection:

FormLSDCollectionMAC
FormLSDTriéCollectionMAC
FormLSDTriéMAC
Données/Validation 5 niveaux MAC

Option Compare Text
Dim f
Private Sub UserForm_Initialize()
  Set f = Sheets("BD")
  Dim a()
  a = Application.Transpose(f.Range("A2:A" & f.[A65000].End(xlUp).Row).Value)
  Me.ComboBox1.List = SansDoublonsMAC(a())
End Sub

Function SansDoublonsMAC(a())
  Dim Maliste As New Collection
  On Error Resume Next
  For i = LBound(a) To UBound(a)
     Maliste.Add Item:=a(i), key:=a(i)
  Next i
  On Error GoTo 0
  Dim b(): ReDim b(1 To Maliste.Count)
  For i = 1 To Maliste.Count
    b(i) = Maliste(i)
  Next i
  SansDoublonsMAC = Application.Transpose(b)
End Function

Listes sans doublons avec 2 colonnes (Nom+prénom)

FormCascadeSansDoublons2colonnesMAC

Dim f, a()
Private Sub UserForm_Initialize()
  Set f = Sheets("bd")
  a = f.Range("A2:D" & f.[A65000].End(xlUp).Row).Value
  Dim collect As New Collection
  Dim Tbl(1 To 2)
  On Error Resume Next
  For i = 1 To UBound(a)
    Tbl(1) = a(i, 1)
    Tbl(2) = a(i, 2)
    collect.Add Tbl, Key:=(a(i, 1) & a(i,2)
  Next i
  On Error GoTo 0
  Dim b(): ReDim b(1 To 2, 1 To collect.Count)
  For i = 1 To collect.Count
    b(1, i) = collect(i)(1)
    b(2, i) = collect(i)(2)
  Next i
  Me.ComboBox1.List = Application.Transpose(b)
End Sub

Collection sans doublons triée (ce qu'il ne faut pas faire)

Sur cet exemple, on tri directement dans l'objet Collection. Le temps de tri est catastrophique (4,3 s pour 2000 éléments cotre 0,06s pour un tri dans un tableau)

Sub CollectionSansDoublonsTrié()
  Dim MaListe As New Collection
  t = Timer
  MaListe.Add Int(Rnd * 10000)
  For i = 1 To 2000
    n = MaListe.Count
    aléa = Int(Rnd * 10000)
    If x > MaListe(n) Then
      MaListe.Add after:=n, Item:=aléa, key:=CStr(aléa)
    Else
      j = 1
      Do While j < n And aléa > MaListe(j)
         j = j + 1
      Loop
      On Error Resume Next
      MaListe.Add before:=j, Item:=aléa, key:=CStr(aléa)
    End If
  Next i
  Application.ScreenUpdating = False
  For i = 1 To MaListe.Count
      Cells(i, 3) = MaListe(i)
  Next i
  MsgBox "Temps:" & Timer - t
End Sub

Le tri est effectué dans un tableau

Sub CollectionSansDoublonsTrié2()
   Dim MaListe As New Collection
   t = Timer
   MaListe.Add Int(Rnd * 10000)
   On Error Resume Next
   For i = 1 To 2000
      n = MaListe.Count
      aléa = Int(Rnd * 10000)
      MaListe.Add after:=n, Item:=aléa, key:=CStr(aléa)
   Next i
   '-- transfert dans un tableau
   Dim TempTab()
   ReDim TempTab(1 To MaListe.Count)
   For i = 1 To MaListe.Count
      TempTab(i) = MaListe(i)
   Next
   Call tri(TempTab, 1, UBound(TempTab, 1))
   Cells(1, 4).Resize(MaListe.Count) = Application.Transpose(TempTab)
   MsgBox "Temps:" & Timer - t
End Sub

Sub tri(a, gauc, droi) ' Quick sort
  ref = a((gauc + droi) \ 2)
  g = gauc: d = droi
  Do
    Do While a(g) < ref: g = g + 1: Loop
    Do While ref < a(d): d = d - 1: Loop
    If g <= d Then
       temp = a(g): a(g) = a(d): a(d) = temp
       g = g + 1: d = d - 1
     End If
   Loop While g <= d
   If g < droi Then Call tri(a, g, droi)
   If gauc < d Then Call tri(a, gauc, d)
End Sub

Collections et tableau

Les éléments d'une collection peuvent être des tableaux.

Sub EssaiCollection()
  Dim MaListe As New Collection
  Dim Tbl(1 To 3)
  Tbl(1) = "Dupont"
  Tbl(2) = 30
  Tbl(3) = "Paris"
  MaListe.Add Tbl

  Tbl(1) = "Martin"
  Tbl(2) = 33
  Tbl(3) = "Montigny"
  MaListe.Add Tbl

  For i = 1 To MaListe.Count
    For col = 1 To 3
       Cells(i + 1, col) = MaListe(i)(col)
    Next col
  Next i
End Sub

Simulation de l'objet Dictionary pour Excel Mac

Principe de la simulation de Dictionary avec 2 collections

Simulation dico avec collection

Sub SimulDictionnareCollection()
  Dim CollecItem As New Collection, CollecCle As New Collection
  nom = "Dupond": age = 30
  CollecCle.Add Item:=nom, Key:=nom
  CollecItem.Add Item:=age, Key:=nom
  nom = "Martin": age = 35
  CollecCle.Add Item:=nom, Key:=nom
  CollecItem.Add Item:=age, Key:=nom
  For i = 1 To CollecCle.Count       ' Toutes les clés et items
    Cells(i + 1, 1) = CollecCle(i)
    Cells(i + 1, 2) = CollecItem(CollecCle(i))
  Next i
End Sub

Pour simuler l'objet Dictionary sur Excel Mac, on crée un module de classe DictionnaireMac.
Cette classe simule la classe Dictionary en lui ajoutant un Tri.
Elle peut remplacer SortedList. Elle permet par exemple:
- d'obtenir des listes triées sans doublon,
- d'effectuer des tris multi-critères de tableaux à 2 dimensions,...

ClasseDictionnaireCollection
ClasseDictionnaireTableau