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

 

[patricktoulon]

re
Bonjour Robert
oui moi aussi j'aime bien l'idée jusqu'au moment ou on fait une vérif de conso
et la on se rend compte que la mono boucle tourne plus que la double boucle
il y a quand même 70% de plus (dans le pire des cas) avec la mono boucle c'est pas rien

plus c'est dans le désordre au départ plus elle va tourner et inversement plus c'est dans l'ordre moins elle tourne

'dans le pire des cas soit  a l'envers carrément  elle met 20 tours 
Sub testMonoBoucle1()
    ReDim t(1 To 5)
    t(1) = "zaza"
    t(2) = "titi"
    t(3) = "loulou"
    t(4) = "fanfan"
    t(5) = "coco"
    t = SortArrayB(t)
    MsgBox Join(t, vbCrLf)
End Sub

'dans le meilleur des cas donc dans l'ordre au départ  elle met 4  tours
Sub testMonoBoucle2()
    ReDim t(1 To 5)
    t(1) = "coco"
    t(2) = "fanfan"
    t(3) = "loulou"
    t(4) = "titi"
    t(5) = "zaza"
    t = SortArrayB(t)
    MsgBox Join(t, vbCrLf)
End Sub

Public Function SortArrayB(ByVal t, Optional Desc As Boolean = True)
    For i = LBound(t) + 1 To UBound(t)
        q = q + 1
        If t(i - Abs(Desc)) > t(i - Abs(Not Desc)) Then
            a = t(i - Abs(Desc))
            t(i - Abs(Desc)) = t(i - Abs(Not Desc))
            t(i - Abs(Not Desc)) = a
            i = i - 2
            If i < LBound(t) Then i = LBound(t)
        End If
    Next
    MsgBox q & " tours de boucle"
    SortArrayB = t
End Function

 

[dysorthographie]

En fait c'était mon posula de départ en partant de l'idée que statiquement les données ne pouvaient pas être complètement dans le désordre.

Si j'ai du temps , la retraite ça offre pas plus de temps ça permet d'en gâcher,je vais comparer en utilisant un redom de 26 lettres sur un tableau de 1000 lignes en faisant une moyenne sur 10 ocurance par exemple.

Car quand je dis stationnement encore faut-il en avoir !

 

[patricktoulon]

j'ai fait le test avec un ordre aléatoire au depart
le résultat parle de lui même
en fait on va de 400% a 1100% en terme de tours par rapport àu nombre d'item de base

ma conclusion:
oui c'est séduisant car on pourrait croire qu'elle est plus rapide et plus economique mais il n'en ai rien c'est même le contraire
le résultat est sans appels
je dois reconnaitre cependant que l'exercice de style est sympa

Dim Q
Sub test()
    Dim F&, I&, T
    Q = 0
    T = Application.Transpose([A1:A13].Value)
    Randomize
    'on mélange les items
    For I = 1 To UBound(T): F = 1 + Int(Rnd * (UBound(T) - 1)): m = T(I): T(I) = T(F): T(F) = m: Next
    texte = "depart: " & Join(T, ",")

    d = SortArrayC(T, False)
    texte = texte & vbCrLf & "après tri: " & Join(d, ",") & vbCrLf
    texte = texte & Q & " tours de boucle" & vbCrLf & String(15, "*")
    Debug.Print texte
End Sub

Public Function SortArrayC(ByVal T, Optional Asc As Boolean = True)
    Dim I&, V, A&, B&
    For I = LBound(T) + 2 To UBound(T)
        Q = Q + 1
        A = I - Abs(Asc)       'index d'échange
        B = I - Abs(Not Asc)   'index d'échange
        If T(A) > T(B) Then
            V = T(A)
            T(A) = T(B)
            T(B) = V
            I = I - 2
            If I < LBound(T) Then I = LBound(T)
        End If
    Next
    SortArrayC = T
End Function

 

[dysorthographie]

Je vais bifer ça de mes tablette, je te dis pas MERCI!

 

[Dranreb]

Bonjour.
Je n'ai pas vu de proposition me semblant raisonnablement fidèle à la classe Scripting.Dictionary.
Alors je propose la mienne.

 

[patricktoulon]

bonjour @Dranreb
il n'y a pas l'overwrite de l'item
comme on ne peut pas se passer d'une fonction intermédiaire "add" par rapport au vrai dico tu aurait pu l'ajouter ou l'inclure dans le add
pour rappel

Je n'ai pas vu de proposition me semblant raisonnablement fidèle à la classe Scripting.Dictionary.

ta méthode keys ne corespond pas au shema du vrai dico
elle n’accepte que les numérique ou rien pour l'array des clés
pareil pour l'items
du coup toute les formules utilisable en lecture d'un vrai dico ne peuvent fonctionner

Spoiler: conclusion

conclusion our l'instant avec ta version l'ai encore moins semblant fidèle
puisque en lecture les propriété sont soit inexistantes soit différemment faite dans la classe

ci joint un classeur avec ton dictionnaire , le mien et 3 sub utilisant la même plage de cellules pour les données
le code c'est le même que le vrai dico sauf le remplissage overwrite qui est impossible par une classe sans fonction
comme tu peux le voir les codes sont les mêmes pour nos deux classes et le vrai dico

Dim dicoD As DranrebDictionary
Dim dicoP As Patrickdictionary
Sub test_dico_de_Dranreb()
    Dim k, it, Cel As Range
    Set dicoD = New DranrebDictionary
    For Each Cel In [A1:a10].Cells
        If Not dicoD.Exists("toto") Then dicoD.Add Cel.Text, Cel.Offset(, 1).Text    'le if not exist est obligatoire  sinon ca plante
    Next
    k = dicoD.keys
    it = dicoD.items

    MsgBox k(1) & "-->" & it(1) 'ne fonctionne pas
    MsgBox dicoD.keys("toto")   'ne fonctionne pas
    MsgBox dicoD.keys(k(1))     'ne fonctionne pas
End Sub

Sub test_dico_de_patrick()
    Dim k, it, Cel As Range
    Set dicoP = New Patrickdictionary
    dicoP.Overwrite_Item = True    'permet d'imiter  le remplissage d'un vrai dico sans "Add"
    For Each Cel In [A1:a10].Cells
        dicoP.Add Cel.Text, Cel.Offset(, 1).Text
    Next
    k = dicoP.keys
    it = dicoP.items
    'mon dico est en base 1
    MsgBox k(1) & "-->" & it(1)
    MsgBox dicoP.keys("toto")
    MsgBox dicoP.keys(k(1))
End Sub


Sub testvraidico()
'comme on peut le voir avec cette méthode on a le overwrite de l'item
    Dim VraiDico As Object, k, it, Cel As Range
    Set VraiDico = CreateObject("Scripting.Dictionary")
    For Each Cel In [A1:a10].Cells
        VraiDico(Cel.Text) = Cel.Offset(, 1).Text
    Next
    k = VraiDico.keys
    it = VraiDico.items

    'le vrai dico est en base 0
    MsgBox k(0) & "-->" & it(0)
    MsgBox VraiDico("toto")
   MsgBox VraiDico(k(0))
   End Sub

regarde le résultat

 

[patricktoulon]

 

[Dranreb]

L'overwrite d'un item est un oubli. Je vais y remédier.
Les propriété Items et Keys d'un Scripting.Dictionary n'ont pas d'argument en fait. Mais elles renvoient des tableaux basés 0, non 1, auxquels on peut préciser dans la foulée un indice. Il ne faut jamais le faire parce qu'il calcule quand même chaque fois tout le tableau. Mais là ce serait quand même dommage de ne pas profiter de l'accès positionnel possible dans une collection.

 

[Dranreb]

Complètement revu la méthode Item …
Ajouté la méthode Key que je ne connaissais pas du tout !

 

[patricktoulon]

Bonjour @Dranreb
ca fonctionne toujours pas

Dim dicoD As DranrebDictionary
Sub test_dico_de_Dranreb()
    Dim k, it, Cel As Range
    Set dicoD = New DranrebDictionary
    For Each Cel In [A1:a10].Cells
        If Not dicoD.Exists(Cel.Text) Then dicoD.Add Cel.Text, Cel.Offset(, 1).Text    'le if not exist est obligatoire  sinon ca plante
    Next
    k = dicoD.Keys
    it = dicoD.Items

    MsgBox k(1) & "-->" & it(1) 'ca y est ça fonctionne
    'MsgBox dicoD.Keys("toto")   'ne fonctionne pas
    'MsgBox dicoD.Keys(CStr(k(0)))     'ne fonctionne pas
End Sub

le keys("chaine de la clé") ne fonctionne toujours pas
et donc le 3eme msgbox non plus

 

[Dranreb]

Bonjour.
Avec un Scripting.Dictionary MsgBox DicoD.Keys("toto") fait une incompatibilité de type.
C'est normal: sa méthode Keys n'attend aucun argument. Mais comme elle renvoie un tableau, il essaie de convertir "toto" en valeur d'indice.
Qu'est ce qui ne va pas dans le mien par rapport à ça ?

 

[patricktoulon]

re
je répète donc
avec une classe on pourrait pas faire
msgbox dico("toto")
pour la simple et bonne raison est qu'après dico on attend un ".fonction ou sub ou property get let set)
donc pour avoir la possibilité de chopper une paire par sa clé
dans ma classe par exemple keys fait les deux soit le paquet soit la clé demandé

ça n'a aucun intérêt de stoker les éléments dans une collection dans une classe si c'est pour s'en servir comme une collection

donc avec un vrai dico c'est
msgbox dico("toto") qui donne l'item
avec la classe se serait
msgbox dico.keys("toto") qui donne aussi l'item

tout simplement par ce que on est obligé de passer par un intermédiaire

je le redis faire un dictionnaire dans une classe sans pourvoir chopper une paire par sa clé n'a vraiment aucun intérêt autant rester dans un module avec une collection

 

[Dranreb]

Non, la méthode par défaut c'est Item, et c'est donc Item qu'il faut préciser puisqu'elle n'est pas assumée.

 

[patricktoulon]

re

Non, la méthode par défaut c'est Item, et c'est donc Item qu'il faut préciser puisqu'elle n'est pas assumée.

je ne te suis pas là


dans un vrai dico quand tu demande une clé
exemple :msgbox dico("toto")
le msgbox te donne son item


j'ai une clé "toto"
tu dois pouvoir me la sortir sans faire le tour de la collection c'est pas compliqué(comme avec un dico)
sinon ton dictionnaire n'est pas un dictionnaire mais une collection

et là je le redis dans ce cas là pas la peine de faire une classe pour ça
un simple module avec une collection et une fonction font la même chose que tu ,fait dans ta classe

 

[RyuAutodidacte]

dans un vrai dico quand tu demande une clé
exemple :msgbox dico("toto")
le mxgbox te donne son item


j'ai une clé "toto"
tu dois pouvoir me la sortir sans faire le tour de la collection c'est pas compliqué(comme avec un dico)
sinon ton dictionnaire n'est pas un dictionnaire mais une collection ???

Hello Patrick, Dranreb,
@patricktoulon
dans une vraie collection quand tu demande une clé
exemple :msgbox Coll("toto")
le mxgbox te donne son item AUSSI