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

patricktoulon · 17 Octobre 2023

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

RyuAutodidacte · 28 Octobre 2023

patricktoulon à dit:

Bonjour Laurent
indexer les lettres de l'alphabet
l'astuce à 2 euros comme ça vite fait à l’arrache

VB:

Sub test()
    x = Split("I.F.G.Z.H.V.J.K.L.M.N.D.B.O.E.P.Q.R.S.C.T.U.A.W.X.Y", ".")
    x = ALPHA_INDEX(x)
    MsgBox Join(x, ",")
End Sub


Function ALPHA_INDEX(arr As Variant)
    ReDim t(LBound(arr) To UBound(arr))
    bas = CLng(LBound(arr) = 0)
    For i = LBound(arr) To UBound(arr)
        Index = Range(arr(i) & "1").Column
        t(Index + bas) = arr(i)
    Next
    ALPHA_INDEX = t
End Function

J'ai peut être qq chose à te proposer, qd j'aurais fini d'adapter ton code quicksort pour mon module de classe, avoir si c'est valable ou pas

Edit : Très malin l'utilisation des colonnes bien vu Patrick

patricktoulon · 28 Octobre 2023

ok
moi j'ai un peu avancer ce matin sur la reconstruction de mon faiseur de baniere

patricktoulon · 28 Octobre 2023

si ca peut mieux t'aider a comprendre comment fonctionne le quicksort
regarde la cosole et lis le log

VB:

Sub test()
q = Array("toto", "franc", "titi", "cedric", "loulou", "fanfan", "ryu", "laurent", "bernard", "riri", "fifi")
Debug.Print "l'array au depart" & vbCrLf & Join(q, ",")
Debug.Print " 1 er appel de la fonction sans argument droite et gauche"
q = SortQuickSort(q, 1)
Debug.Print "la fonction a fini son job "
Debug.Print Join(q, ",")
End Sub
Function SortQuickSort(tbl, Optional Sortmode As Long = 1, Optional Gauche = -1, Optional Droite = -1) ' Quick sort
    Dim ref, G&, D&, temp1, First, tim#
    If Droite = -1 And Gauche = -1 Then First = 1 Else First = 0
    Droite = IIf(Droite = -1, UBound(tbl), Droite)

    Gauche = IIf(Gauche = -1, LBound(tbl), Gauche)
    ref = tbl((Gauche + Droite) \ 2)    'le pivot( change de position au fur et a mesure)

    G = Gauche: D = Droite    'on dédouble les variable gauche et droite pour l'incrémentation dans les deux do/loop droite et gauche

Debug.Print "donc gauche =" & Gauche & " et droite = " & Droite
Debug.Print "donc G =" & Gauche & " et D = " & Droite
Debug.Print "det bien entendu ref qui est au milieu = " & ref

    Do
        If Sortmode = 1 Then
            Do While tbl(G) < ref: G = G + 1:: Loop         'on comptabilise le passage
            Do While ref < tbl(D): D = D - 1: q = q + 1:: Loop  'on comptabilise le passage
        Else
            Do While tbl(G) > ref: G = G + 1:: Loop         'on comptabilise le passage
            Do While ref > tbl(D): D = D - 1: q = q + 1:: Loop 'on comptabilise le passage
        End If

        'intervertion des itemS tbl(G) à gauche du pivot et l'item tbl(d) à droite du pivot
        If G <= D Then
       Debug.Print "lancement des  deux boucles do/loop avec G et D et résultat !! " & "G= " & G & " et  D = " & D & " soit "; tbl(G) & " est <= que " & ref
       Debug.Print "intervertiti donc "
       temp1 = tbl(G): tbl(G) = tbl(D): tbl(D) = temp1
            G = G + 1: D = D - 1
            Ch = Ch + 1
        End If
    Debug.Print "résultat " & Join(tbl)
    Debug.Print "et on reboucle jusqu'a que G soit > D"
    Loop While G <= D

    'si g ou gauche est plus petit on relance un appel  de la fonction (c'est la récursivité)
    If G < Droite Then x = SortQuickSort(tbl, Sortmode, G, Droite): Debug.Print "c'est  G(pas Gauche qui est  < Droite trouvé on relance la fonction en appel récursif avec le nouveau gauche et droite  donc G et droite "



    If Gauche < D Then x = SortQuickSort(tbl, Sortmode, Gauche, D): Debug.Print "c'est   Gauche(pas G) qui est  < D trouvé on relance la fonction en appel récursif avec le nouveau gauche et droite  donc G et droite "


    'pour économiser un peu la charge memoire du return de la fonction on la charge dès que l'on revients à first
    'c'est à dire quand il n'y a plus d'appel récursifs
    If First = 1 Then SortQuickSort = tbl
End Function

RyuAutodidacte · 28 Octobre 2023

patricktoulon à dit:

si ca peut mieux t'aider a comprendre comment fonctionne le quicksort
regarde la cosole et lis le log

VB:

Sub test()
q = Array("toto", "franc", "titi", "cedric", "loulou", "fanfan", "ryu", "laurent", "bernard", "riri", "fifi")
Debug.Print "l'array au depart" & vbCrLf & Join(q, ",")
Debug.Print " 1 er appel de la fonction sans argument droite et gauche"
q = SortQuickSort(q, 1)
Debug.Print "la fonction a fini son job "
Debug.Print Join(q, ",")
End Sub
Function SortQuickSort(tbl, Optional Sortmode As Long = 1, Optional Gauche = -1, Optional Droite = -1) ' Quick sort
    Dim ref, G&, D&, temp1, First, tim#
    If Droite = -1 And Gauche = -1 Then First = 1 Else First = 0
    Droite = IIf(Droite = -1, UBound(tbl), Droite)

    Gauche = IIf(Gauche = -1, LBound(tbl), Gauche)
    ref = tbl((Gauche + Droite) \ 2)    'le pivot( change de position au fur et a mesure)

    G = Gauche: D = Droite    'on dédouble les variable gauche et droite pour l'incrémentation dans les deux do/loop droite et gauche

Debug.Print "donc gauche =" & Gauche & " et droite = " & Droite
Debug.Print "donc G =" & Gauche & " et D = " & Droite
Debug.Print "det bien entendu ref qui est au milieu = " & ref

    Do
        If Sortmode = 1 Then
            Do While tbl(G) < ref: G = G + 1:: Loop         'on comptabilise le passage
            Do While ref < tbl(D): D = D - 1: q = q + 1:: Loop  'on comptabilise le passage
        Else
            Do While tbl(G) > ref: G = G + 1:: Loop         'on comptabilise le passage
            Do While ref > tbl(D): D = D - 1: q = q + 1:: Loop 'on comptabilise le passage
        End If

        'intervertion des itemS tbl(G) à gauche du pivot et l'item tbl(d) à droite du pivot
        If G <= D Then
       Debug.Print "lancement des  deux boucles do/loop avec G et D et résultat !! " & "G= " & G & " et  D = " & D & " soit "; tbl(G) & " est <= que " & ref
       Debug.Print "intervertiti donc "
       temp1 = tbl(G): tbl(G) = tbl(D): tbl(D) = temp1
            G = G + 1: D = D - 1
            Ch = Ch + 1
        End If
    Debug.Print "résultat " & Join(tbl)
    Debug.Print "et on reboucle jusqu'a que G soit > D"
    Loop While G <= D

    'si g ou gauche est plus petit on relance un appel  de la fonction (c'est la récursivité)
    If G < Droite Then x = SortQuickSort(tbl, Sortmode, G, Droite): Debug.Print "c'est  G(pas Gauche qui est  < Droite trouvé on relance la fonction en appel récursif avec le nouveau gauche et droite  donc G et droite "



    If Gauche < D Then x = SortQuickSort(tbl, Sortmode, Gauche, D): Debug.Print "c'est   Gauche(pas G) qui est  < D trouvé on relance la fonction en appel récursif avec le nouveau gauche et droite  donc G et droite "


    'pour économiser un peu la charge memoire du return de la fonction on la charge dès que l'on revients à first
    'c'est à dire quand il n'y a plus d'appel récursifs
    If First = 1 Then SortQuickSort = tbl
End Function

super top les explications comme cela

Merci bcp

RyuAutodidacte · 29 Octobre 2023

Re @patricktoulon
Ton code avec les explications en Debug.Print m'a bien aidé

:

VB:

Sub NewQuickSorts()
Dim Tb
    Tb = Array("DKS§6", "Min§1", "MAX§3", "True§2", "False§4", "Boolean§5")
    Tb = SortQuickSort(Tb, , , , True)
End Sub

Function SortQuickSort(tbl, Optional Sortmode As Long = 1, Optional Gauche = -1, Optional Droite = -1, Optional Boo As Boolean, Optional Sep As Integer = 167) ' Quick sort
    Dim ref, G&, D&, temp1, First, tim#
    If Droite = -1 And Gauche = -1 Then First = 1 Else First = 0
    Droite = IIf(Droite = -1, UBound(tbl), Droite)

    Gauche = IIf(Gauche = -1, LBound(tbl), Gauche)
    If Boo Then ref = Mid(tbl((Gauche + Droite) \ 2), InStrRev(tbl((Gauche + Droite) \ 2), ChrW(Sep)) + 1) Else ref = tbl((Gauche + Droite) \ 2)

    G = Gauche: D = Droite

    Do
        If Sortmode = 1 Then
            Do While IIf(Boo, Mid(tbl(G), InStrRev(tbl(G), ChrW(Sep)) + 1), tbl(G)) < ref: G = G + 1:: Loop
            Do While ref < IIf(Boo, Mid(tbl(D), InStrRev(tbl(D), ChrW(Sep)) + 1), tbl(D)): D = D - 1:: Loop
        Else
            Do While IIf(Boo, Mid(tbl(G), InStrRev(tbl(G), ChrW(Sep)) + 1), tbl(G)) > ref: G = G + 1:: Loop
            Do While ref > IIf(Boo, Mid(tbl(D), InStrRev(tbl(D), ChrW(Sep)) + 1), tbl(D)): D = D - 1:: Loop
        End If

        If G <= D Then
       temp1 = tbl(G): tbl(G) = tbl(D): tbl(D) = temp1
            G = G + 1: D = D - 1
            Ch = Ch + 1
        End If
    Loop While G <= D

    If G < Droite Then x = SortQuickSort(tbl, Sortmode, G, Droite, Boo, Sep)

    If Gauche < D Then x = SortQuickSort(tbl, Sortmode, Gauche, D, Boo, Sep)

    If First = 1 Then SortQuickSort = tbl
End Function

Merci

patricktoulon · 29 Octobre 2023

re
bonjour ryu
ok je vois l'intention
le tri par le suffixe

patricktoulon · 29 Octobre 2023

alors
que pourrais-je bien dire
sur l'intention
et la manière de la mettre en œuvre

1°l'intention
elle est intéressante dans le sens ou on peut trier avec une partie de la valeur des items

2°la manière de la mettre en œuvre
là par contre il y aurais a redire
a°)il serait intéréssant de pouvoir le faire par le préfixe (la valeur avant le caractère de séparation )
b°)le caractère par défaut n'est pas rien donc tu est obligé d'ajouter un argument "boo" pour trier par la valeur complète
c°) tes conditions iif(boo.....) dans les doloop de recherche sont risqués
car le instrrev(valeur,"caractere) renvoie -1 si le caractère n'est pas dans la chaine (DOMMAGE!!!)

A Méditer

RyuAutodidacte · 29 Octobre 2023

Re
ChrW(167) fais partit du module de classe il est ok aussi bien sur windows que sur Mac et il y sera forcément dans l'array
pour le a) je ne pense pas que ca change qq chose pour le tri, il le mettra dans l'ordre avant le § et finira l'odre exact après le §
b) le Boo n'est que pour trier tout ce qui se trouve après le §
c) impossible car tu trouvera tjs le caractère de séparation §

patricktoulon · 29 Octobre 2023

re
ouais ouais
allez

VB:

Sub NewQuickSorts()
    Dim Tb
    Tb = Array("DKS§6", "Min§1", "MAX§3", "True§2", "False§4", "Boolean§5")
    'Tb = SortQuickSort(Tb, 1, -1, -1, 167)'        tri par suffixe croissant full argument(argument sepa en numerique)
    'Tb = SortQuickSort(Tb, 1, -1, -1, "§")'        tri par suffixe croissant full argument(argument sepa en string)
    'Tb = SortQuickSort(Tb, 2) '                    tri par chaine complète decroissant
    'Tb = SortQuickSort(Tb, 1)  '                   tri par chaine complète croissant
    'Tb = SortQuickSort(Tb, Sepa:="§") '            tri par suffixe (croissant par defaut) (argument sepa en string)
    Tb = SortQuickSort(Tb, Sepa:="à")    '          (test avec un mauvais separateur) tri par suffixe (croissant par defaut) (argument sepa en string)

    MsgBox Join(Tb, ",")
End Sub



Function SortQuickSort(tbl, _
                       Optional Sortmode& = 1, _
                       Optional Gauche& = -1, _
                       Optional Droite& = -1, _
                       Optional Sepa As Variant = "~")   ' Quick sort

    Dim ref, G&, D&, temp1, First, tim#
    If Droite = -1 And Gauche = -1 Then First = 1 Else First = 0

    Droite = IIf(Droite = -1, UBound(tbl), Droite)

    If Val(Sepa) > 0 Then Sepa = Chr(Sepa)
    Gauche = IIf(Gauche = -1, LBound(tbl), Gauche)

    ref = tbl((Gauche + Droite) \ 2)

    G = Gauche: D = Droite

    Do
        If Sortmode = 1 Then
            Do While Split(tbl(G), Sepa)(Abs(tbl(G) Like "*" & Sepa & "*")) < Split(ref, Sepa)(Abs(ref Like "*" & Sepa & "*")): G = G + 1:: Loop
            Do While Split(ref, Sepa)(Abs(ref Like "*" & Sepa & "*")) < Split(tbl(D), Sepa)(Abs(tbl(D) Like "*" & Sepa & "*")): D = D - 1:: Loop
        Else
            Do While Split(tbl(G), Sepa)(Abs(tbl(G) Like "*" & Sepa & "*")) > Split(ref, Sepa)(Abs(ref Like "*" & Sepa & "*")): G = G + 1:: Loop
            Do While Split(ref, Sepa)(Abs(ref Like "*" & Sepa & "*")) > Split(tbl(D), Sepa)(Abs(tbl(D) Like "*" & Sepa & "*")): D = D - 1:: Loop
        End If

        If G <= D Then
            temp1 = tbl(G): tbl(G) = tbl(D): tbl(D) = temp1
            G = G + 1: D = D - 1
            Ch = Ch + 1
        End If
        Debug.Print "résultat " & Join(tbl)
        Debug.Print "et on reboucle jusqu'a que G soit > D"
    Loop While G <= D

    If G < Droite Then x = SortQuickSort(tbl, Sortmode, G, Droite, Sepa): Debug.Print "c'est  G(pas Gauche qui est  < Droite trouvé on relance la fonction en appel récursif avec le nouveau gauche et droite  donc G et droite "

    If Gauche < D Then x = SortQuickSort(tbl, Sortmode, Gauche, D, Sepa): Debug.Print "c'est   Gauche(pas G) qui est  < D trouvé on relance la fonction en appel récursif avec le nouveau gauche et droite  donc G et droite "

    If First = 1 Then SortQuickSort = tbl
End Function

voilà c'est blindé le truc

patricktoulon · 29 Octobre 2023

re

b) le Boo n'est que pour trier tout ce qui se trouve après le §

je le met en rouge car apparemment tu n'a pas percuté
tu pourrais m'expliquer
pourquoi je ferais une fonction(ce que tu a fait entre ())
avec un argument (sep) pour pointer un caractère et un argument (boo)pour dire a la fonction de ne pas tenir compte du caractère que je lui envoie
puisque c'est optionnel tu n'a pas besoins de deux variables tu envoie ou pas le caractère c'est tout

c) impossible car tu trouvera tjs le caractère de séparation §

a oui ça tu ,n'en sais rien justement
la tu teste un array soigneusement préparer avec des items contenant ce caractère
mais quand tu le diffusera toute sorte de tableaux devront être triés

réfléchissez réfléchissez quand vous développez une fonction

patricktoulon · 29 Octobre 2023

bon allez je te met un 15 par ce que l'idée est intéressante
mais j'enlève 4 points , pour une mauvaise maitrise de l'environnement
a fin de te laisser au dessus de la moyenne
mais c'est une fleur que je te fait hein !!! que je t'y reprenne plus

RyuAutodidacte · 29 Octobre 2023

patricktoulon à dit:
bon allez je te met un 15 par ce que l'idée est intéressante
mais j'enlève 4 points , pour une mauvaise maitrise de l'environnement
a fin de te laisser au dessus de la moyenne
mais c'est une fleur que je te fait hein !!! que je t'y reprenne plus

re
tu n'as pas encore tous les tenants et aboutissants
et là je suis sur la version 1 que je n'ai pas encore scruté dans son ensemble pour voir si tout est ok ou si j'ai qq modif à faire avant de la poster

PS : je vais sortir toute l'après midi …, ne l'attend pas de suite …
je regarderai par la suite tes remarques en détails, ferai le gros ménage sur ce fichier ou j'en ai mis partout, scruterai l'ensemble de mon module de classe pour correction ou non, puis je préparerai les différent exemples avant de poster

patricktoulon · 29 Octobre 2023

RyuAutodidacte · 30 Octobre 2023

Hello @patricktoulon ,@Dranreb et tous

Je suis tombé sur un pb très bizarre, c'est bien la 1ère fois que j'ai ça …
Dans l'une de mes fonctions dans le module de classe après la vérification d'un If si celui-ci donne vrai alors j'envoie le résultat de la fonction puis je fais un Exit Function
Chose hallucinante, cela me fais une erreur 13 sur le Exit Function … pourquoi ?

vous avez une idée ?

patricktoulon · 30 Octobre 2023

Bonjour ryu
ben déjà comme ca et j'en suis presque sur (par rapport à ce que tu me dis )
tu fait les choses à l'envers
l'erreur que tu a c'est par ce que le if donne faux

on exit pas une fonction par ce qu'elle donne bon mais par ce qu'elle donne faux
mais avant on lui donne une valeur sinon elle va déclencher une erreur sur l'appelant mais tu aurra l'erreur sur la fonction en jaune dans vbe alors que la fonction a tout simplement rien renvoyé

VB:

function mafonction(a,b,c,etc...)
'blablabla
'blablabla
'blablabla
if blablabla=false then mafonction="ceci":exit function
mafonction=letrucdeblablabla
end function

donne moi le code la fonction

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

XLDnaute Barbatruc

Pièces jointes

XLDnaute Impliqué

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Impliqué

XLDnaute Impliqué

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Impliqué

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Barbatruc

Pièces jointes

XLDnaute Impliqué

XLDnaute Barbatruc

XLDnaute Impliqué

XLDnaute Barbatruc

Partager cette page

Statistiques des forums