Public elements As New Collection
Public key
Public item
Public Function Add(k, Optional i As Variant = "")
ind = Me.Exists(k)
If ind = 0 Then
Dim cl As New dictionnaire
cl.key = k
cl.item = i
Me.elements.Add cl
Else
Me.elements(ind).item = i
End If
End Function
Public Function Exists(k) As Long
For Each elem In Me.elements
i = i + 1: If elem.key = k Then Exists = i: Exit For
Next
End Function
Public Function Items(): ReDim t(1 To elements.Count): For Each elem In elements: i = i + 1: t(i) = elem.item: Next: Items = t: End Function
Public Function Keys(): ReDim t(1 To elements.Count): For Each elem In elements: i = i + 1: t(i) = elem.key: Next: Keys = t:: End Function
Public Function ToTable(): ReDim t(1 To elements.Count, 1 To 2): For Each elem In elements: i = i + 1: t(i, 1) = elem.key: t(i, 2) = elem.item: Next: ToTable = t: End Function
Dim dico As dictionnaire
Sub ecriture()
Set dico = New dictionnaire
dico.Add "toto", "28"
dico.Add "titi", "54"
dico.Add "riri", "48"
dico.Add "toto", "22"
If dico.Exists("toto") = 0 Then dico.Add "toto", "74"
End Sub
Sub lecture()
If dico.elements.Count = 0 Then MsgBox "le dico est vide": Exit Sub
For Each elem In dico.elements
MsgBox "key: " & elem.key & "--item: " & elem.item
Next
End Sub
' lecture des clé et items
Sub lecture2()
If dico.elements.Count = 0 Then MsgBox "le dico est vide": Exit Sub
MsgBox Join(dico.Keys, vbCrLf)
End Sub
Sub lecture3()
If dico.elements.Count = 0 Then MsgBox "le dico est vide": Exit Sub
MsgBox Join(dico.Items, vbCrLf)
End Sub
Sub dicototable()
If dico.elements.Count = 0 Then MsgBox "le dico est vide": Exit Sub
x = dico.ToTable
Cells(1, 1).Resize(UBound(x), 2) = x
End Sub
Private Key
Private Item
Private Sub Class_Initialize()
Dim t(), t2(): ReDim Preserve t(0): ReDim Preserve t2(0): Key = t: Item = t2
End Sub
Public Function Add(k As String, Optional i As Variant = "", Optional ByVal Overwrite_Item As Boolean = True)
x = Application.IfError(Application.Match(k, Key, 0), 0)
If x = 0 Then
a = UBound(Key) + 1: ReDim Preserve Key(1 To a): ReDim Preserve Item(1 To a): Key(a) = k: Item(a) = i
Else
If Overwrite_Item Then Item(x) = i
End If
End Function
Public Function keys(Optional k As String = "")
If k = "" Then keys = Key Else For i = 1 To UBound(Key): keys = IIf(Key(i) = k, Item(i), ""): Next
End Function
Public Function items(Optional it As String = "")
If it = "" Then
items = Item
Else: For i = 1 To UBound(Item)
If Item(i) = it Then items = Key(i)
Next
End If
End Function
Function Sort()
Dim temp, temp2, i&, a&
For i = 1 To UBound(Key) - 1
For a = i + 1 To UBound(Key)
If Key(i) > Key(a) Then
temp = Key(i): temp2 = Item(i)
Key(i) = Key(a): Key(a) = temp
Item(i) = Item(a): Item(a) = temp2
End If
Next
Next
End Function
Dim dico As dictionary
Sub dest()
Dim k, it
Set dico = New dictionary
dico.Add "toto", "25"
dico.Add "lolo", "33"
dico.Add "fifi", "42"
dico.Add "toto", "39", False
dico.Sort
k = dico.keys: it = dico.items
txt = vbTab & vbCrLf
For i = 1 To UBound(k)
txt = txt & "key: = " & k(i) & " item: = " & it(i) & vbCrLf
Next
MsgBox txt
MsgBox "la clé toto donne " & dico.keys("toto")
MsgBox "l 'item 33 donne " & dico.items(33)
End Sub