XL 2013 les machistes (utilisateurs de Mac OS peuvent ils tester ceci

[patricktoulon]

Bonjour à tous
@RyuAutodidacte m' a rappelé un lien vers un amis de l'autre monde concernant une classe pseudo dictionnaire pour MAC
malgré que j'apprécie beaucoup l'auteur (avec qui j'ai même collaboré sur l’accélérateur de requête entre autres ) ,je trouve que c'est un peu usine à gaz

j'ai donc fait les choses à ma façon
mais avant d'aller plus loin car des idées j'en ai plein ,si vous êtes un utilisateur sur MAC pouvez vous tester ce pseudo dictionnaire
sur Windows ça match il me faut confirmation sur MAC

Merci pour vos retours

 

[laurent950]

Bonsoir @patricktoulon

Je veux bien, je fais cela juste pour l'exercice est comprendre. Tu es très fort et je suis arrivé à mes limites. Mais je veux bien voir pour apprendre un peux plus avec plaisir Patrick

 

[patricktoulon]

re
non tu n'est pas arrivé a tes limites tu met la charue avant les boeufs c'est tout
tu es gourmand (et c'est pas nouveau) des truc complexes
mais ce n'est pas parceque c'est complexe qui faut usiner
raisonne object , object.quoi

alors voila le module classe

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

ET OUI C EST TOUT !!!!!
voila le module standard dans le quel je pilote

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

voila et c'est tout et on a déjà la fonction totable

 

[laurent950]

Re @patricktoulon

Mille mercis pour ton code, Patrick. Il est vraiment très bien construit, bien plus simple que ce que j'avais réalisé. Je dois encore apprendre et comprendre le concept d'objet, et ton code en démontre bien les possibilités et la puissance du modèle objet.

Ton code est écrit avec élégance, ce qui le rend bien plus simple à maintenir et à adapter lorsque nous devons revenir pour décrypter les lignes de code et y apporter des améliorations, en réponse aux évolutions du logiciel Excel, et ce, dans les évolutions des versions, le cas échéant.

Je te remercie, car cela m'aide également à aborder le code sous un nouvel angle grâce à ton travail de qualité.

Merci Patrick.

 

[patricktoulon]

re
de rien et merci pour les compliments
mais attention je persiste a dire que collectionner en plusieurs instance c'est pas la meilleure solution
celle que j'ai utilisé dans ma classe finale est mieux en terme d’accès en lecture et écriture

 

[patricktoulon]

Bonjour @laurent950
si tu veux j'ai même mieux
SANS DICO ET SANS COLLECTION!!!!!

 

[laurent950]

Bonsoir @patricktoulon

je veux bien voir avec plaisir ce code que tu as réalisé

 

[patricktoulon]

re
tu va pleurer tellement c'est simple
le module classe toujours nommé "Dictionary"

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

et le module de test

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

 

[patricktoulon]

et je viens de faire encore mieux

 

[laurent950]

Bonjour @patricktoulon

ce code est très simple et aussi très astucieux. je vais m'inspiré de cela.

Merci Patrick

 

[patricktoulon]

réfléchi un peu

 

[laurent950]

Ré @ PatrickToulon

J'ai compris impeccable merci, le code que tu as réalisé est super.

Laurent

 

[patricktoulon]

j'essaie d'avoir des items(x) object range ou valeur range
mais c'est compliqué de mélanger les deux types
mais dans tout les case c'est dico.Add clé,R et pas l'inverse

 

[patricktoulon]

bon c'est bon
j'ai les items range ou string
j'ai a nouveau les fonctions

1. Add
2. sort
3. KeyItemReverse
4. keys
5. items
6. ToTable

mais il y a en plus (nouveau!!)
les propriétés

1. count
2. overwrite_item boolean
3. cumulate_item

le tout sans collection
je met ça au propre

 

[laurent950]

Ré @patricktoulon

Tu es très fort,

 

[patricktoulon]

re