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

patricktoulon · 9 Novembre 2023

re
je l'ai réécrite en une seule fonction
je la met dans le recueil tout à l'heure
temps d’exécution entre 0.35 et 0.50 pour 10 000

patricktoulon · 9 Novembre 2023

re
quelque chose à ajouter ?

VB:

'******************************************************************************************************************************************************
'    __    _  _  _   _  _       _   _ _______  ___     ___     _  ___     _       ____ _______  ____
'   // \\ // // //  // /\\     //  //   //    //  \\  // ||   // // ||   /\\     //      //    //
'  //__// \\// //  // //__\   //  //   //    //   // //  ||  // //  ||  //__\   //      //    //__
' //  \\   // //  // //   \\ //  //   //    //   // //   // // //   // //   \\ //      //    //
'//   //  // //__// //    ////__//   //     \\__// //___// // //___// //    ////___   //    //___
'******************************************************************************************************************************************************
'méthode 6
'Auteur: Ryuautodidacte et patricktoulon sur ExcelDownloads
'version1 1.0
'réécrite en une seule fonction par patricktoulon
'insertion des code sortinsertbubble intra code
' cette fonction reside sur le fait d'utiliser un object collection qui va contenir dans les valeur un array de chaine similaire
'ou commencant par les meme caractères
'ensuite on va trier chaque sub array avec la méthode sortinsertbubble de patricktoulon
'ensuite on va refaire une passe sortinserbubble sur le TAg général (qui contioent des sub arrary)
'et le trier par la valeur du premier item de chaque array
'et pour finir on recompile les sub array dans un seul tableau (celui d'origine )
'
'vous l'avez compris on est dans la catégorie de fonction de tri dite "Diviser pour mieux reigner"
'en effet les boucles sont moins longues et plus rapide a trier
'mis apart l'object collection on est tres proche de la méthode fusion coisée avec l'insertion
'*****************************************************************************************************
Option Base 1
Dim Q
Dim ch
Sub test()
    Dim tb, tim#
   Q = 0: ch = 0
   tb = Cells(1).CurrentRegion.Value
    Cells(1, 3).Resize(UBound(tb)).ClearContents
    tim = Timer
    tb = SortRyuPatKey(tb)
    MsgBox Format(Timer - tim, "#0.00") & " sec" & vbCrLf & Q & " TOURS DE BOUCLE" & vbCrLf & ch & " INTERVERTIONS"
    Cells(1, 3).Resize(UBound(tb)) = (tb)

End Sub

Function SortRyuPatKey(tb)
    Dim TA(), SortColl As New Collection, GetTA, Tmps!, L, a&, b&, x&, ref, SubTB, SubTBA
    
    For Each t In tb
        ReDim NewTB(1 To 1)
        L = Mid(t, 1, Len(t) - 1): S = Len(t): cle = L & "|" & S
        On Error Resume Next
        SortColl.Add IIf(SortColl.Count = 0, 1, SortColl.Count + 1), cle
        If Err Then
            GetTA = TA(SortColl(cle)): ReDim Preserve GetTA(1 To UBound(GetTA) + 1): GetTA(UBound(GetTA)) = t: TA(SortColl(cle)) = GetTA
        Else
            ReDim Preserve TA(1 To SortColl.Count): TA(SortColl(cle)) = Array(t)
        End If
    Next

    'tri SortInsertBubble des sub array dans l'array TA
    For i = 1 To UBound(TA)
        SubTB = TA(i)
        For a = LBound(SubTB) To UBound(SubTB)
            ref = SubTB(a)
            x = a
            For b = a + 1 To (UBound(SubTB))
                Q = Q + 1
                If ref > SubTB(b) Then ref = SubTB(b): x = b:
            Next b
            If x <> a Then TP = SubTB(a): SubTB(a) = SubTB(x): SubTB(x) = TP: ch = ch + 1
        Next a
        TA(i) = SubTB
        Q = Q + 1
    Next

    ' second tri sortinsertbubble sur le TA genéral
    ' le tri va se faire sur le premier item de chaque array dans subTBA
    SubTBA = TA
    For a = LBound(SubTBA) To UBound(SubTBA)
        ref = SubTBA(a)(1)
        x = a
        For b = a + 1 To (UBound(SubTBA))
            Q = Q + 1
            If ref > SubTBA(b)(1) Then ref = SubTBA(b)(1): x = b:

        Next b
        If x <> a Then TP = SubTBA(a): SubTBA(a) = SubTBA(x): SubTBA(x) = TP: ch = ch + 1
    Next a
    TA = SubTBA

    ReDim tb(1 To 1)
    n = 0
    For Each arr In TA
        Q = Q + 1
        ReDim Preserve tb(1 To n + UBound(arr))
        For i = 1 To UBound(arr)
            Q = Q + 1
            tb(i + n) = arr(i)
        Next
        n = UBound(tb)
    Next
     SortRyuPatKey = Application.Transpose(tb)
End Function

RyuAutodidacte · 9 Novembre 2023

prépare toi, … faut que je teste … mais je pense pouvoir améliorer la vitesse des 3 1er tri (enfin j'espère si ce que pense est ok) en 1 ou 2 boucles et je supprime pleins de boucles …

ca sera pour ce soir normalement … à suivre

patricktoulon · 9 Novembre 2023

ok j'edite pas la source encore alors

patricktoulon · 9 Novembre 2023

pour le moment tu es la plus rapide des plus lentes sur 10 000 et 100 000 items
par contre en terme d'uc de memoire et procc tu est de loin la plus lourde

classement de la plus lente à la plus rapide
bubble 8 secondes pour 10 000 items
insertion 7 secondes pour 10 000 items
insertionbubble hybride 2.80/3.50 secondes pour 10 000 items
SortRyuPatKey <--ici 0.55/0.70 secondes pour 10 000 items

les plus rapides

fusion 0.05/0.06. secondes pour 10 000 items
shellmetzner 0.04 /0.06 secondes pour 10 000 items
quiksort patrick 2dim 0.03/0.04 secondes pour 10 000 items

LA PLUS RAPIDE!!!
quicksortpatrick 1 dim execo avec quicksort laurent 0.0.18/0.03 sur 10 000 items
quicksort Laurent a tendence a être un peu devant (Bravo Laurent

)

classement de la plus lourde a la moins lourde
SortRyuPatKey et de loin( a peu près 800% de plus que la insertion )
insertion
insertionbubble
bubble
quicksort laurent
shellmetzner
fusion
quicksortpatrick2 dim
quicksort patrick 1dim

RyuAutodidacte · 9 Novembre 2023

C’est quoi qui rend lourd au niveau uc ?
Peux tu détailler stp ?
Les ordi d’aujourd’hui gère facilement ce genre de processus

patricktoulon · 9 Novembre 2023

ben deja tu collectionne
1°object collection
ensuite tu a un array TA qui contient les valeur(les mêmes des items collection)
tu a donc 2 fois les valeurs en memoire
tu transmet a tes boucles de tri les tableaux ils travaillent donc sur une copie allez encore de la memoire et du procc
et cela tu le fait 2 fois

ensuite tu recompile ton TB qui est deja plein mais tu lui replace en fait les element de sub array de TA
selon tes tri précédents de TA

à part la fusion les autres méthodes travail sur un seul tableau qui se balade dans les boucle et se fait mal mené mais pour son bien
d'ailleur on le vois bien quand on lance les fonction curseur rond d'attente qui tourne
mais on le vois mieux en affichant la conso dans gestionaire des taches/performence

patricktoulon · 9 Novembre 2023

re

RyuAutodidacte · 9 Novembre 2023

patricktoulon à dit:
pour le moment tu es la plus rapide des plus lentes sur 10 000 et 100 000 items
par contre en terme d'uc de memoire et procc tu est de loin la plus lourde

classement de la plus lente à la plus rapide
bubble 8 secondes pour 10 000 items
insertion 7 secondes pour 10 000 items
insertionbubble hybride 2.80/3.50 secondes pour 10 000 items
SortRyuPatKey <--ici 0.55/0.70 secondes pour 10 000 items

les plus rapides

fusion 0.05/0.06. secondes pour 10 000 items
shellmetzner 0.04 /0.06 secondes pour 10 000 items
quiksort patrick 2dim 0.03/0.04 secondes pour 10 000 items

LA PLUS RAPIDE!!!
quicksortpatrick 1 dim execo avec quicksort laurent 0.0.18/0.03 sur 10 000 items
quicksort Laurent a tendence a être un peu devant (Bravo Laurent )

classement de la plus lourde a la moins lourde
SortRyuPatKey et de loin( a peu près 800% de plus que la insertion )
insertion
insertionbubble
bubble
quicksort laurent
shellmetzner
fusion
quicksortpatrick2 dim
quicksort patrick 1dim

tu ne comptes pas le tri de Laurent que j'avais modifié (uniquement pour les chiffres entier) … ? plus rapide que quicksort …

patricktoulon · 9 Novembre 2023

re
elle est hors course celle là car justement elle n'est pas pluri-disciplinnaire
et pour tout te dire elle n'a pas grand intérêt
utiliser la valeur pour l'index et supprimer les blancs ,je faisais ça quand je débutais

elle est connue et plus que connue ( c'est pas pour dénigrer laurent )
lui aussi nous a sorti une belle chose ,que j'ai retrouvé en JS plusieurs fois sur la toile

par contre toi tu a le mérite de nous avoir sorti ( en utilisant ma sortinsertion) une méthode qui n'existe nulle part ailleurs
alors la oui ca mérite d'être dans le recueil

patricktoulon · 9 Novembre 2023

re
on pourrait l'améliorer en mettant ma sortinsertbubble2(avance et recule)
je te l'ai pas montré celle là hein

VB:

'******************************************************************************************************************************************************
'    ___     _     _______  __      _  ____  _   _    _______  ___     _   _  _    ___     _     _.
'   //  \\  /\\      //    // \\   // //    //  //      //    //  \\  //  // //   //  \\  //|   //
'  //___// //__\    //    //__//  // //    //__//      //    //   // //  // //   //   // // |  //
' //      //   \\  //    //  \\  // //    //  \\      //    //   // //  // //   //   // //  | //
'//      //    // //    //   // // //___ //    \\    //     \\__// //__// //___ \\__// //   |//
'******************************************************************************************************************************************************
'RECEUIL DE M2THODE DE TRI D UN ARRAY
'Méthode 2.1 patricktoulon
'                                  HYbridemixe de ( Bubble et Insertion)
' dans cette version je mixe la méthode bubble et la méthode insertion
'les items ne sont déplacé qu'une fois (si nécessaire)
'la premiere boucle est la répéteuse et donne le pivot(la référence)
'la seconde tourne a moitié du restant du nombre d'item
'cherche le plus petit de index boucle1 a moitié restant et du ubound jusque a index B
'en sortie de 2d boucle je fait l'interversion
Dim q&
Dim ch&
Sub Test3InsertBuble3()
    Dim T, tim#
    ch = 0: q = 0
    T = Application.Transpose([A1:A10000].Value)
    [j8:l8] = ""
    tim = Timer
    T = sortInsertBubble3(T)
    [j8:l8] = Array(q, ch, Format(Timer - tim, "#0.00 ""sec"""))
    Cells(1, 3).Resize(10000).Value = Application.Transpose(T)
End Sub

Function sortInsertBubble3(T)
    Dim A&, B&, C&, x&, ref

    For A = LBound(T) To UBound(T)
        ref = T(A)
        x = A
        C = UBound(T)
        w = (UBound(T) - A) / 2
        'Dans une seule boucle B avance de A+1 vers le ubound et C recule du ubound vers B
        ' quand les deux se rencontrent on arrete de boucler
        ' on fait donc la moitié du nombre de tours de la hybride 1

        For B = A + 1 To UBound(T) - w
            q = q + 1
            If ref > T(B) Then ref = T(B): x = B:
            If ref > T(C) Then ref = T(C): x = C:
            C = C - 1
        Next
        If T(x) < T(A) Then TP = T(A): T(A) = T(x): T(x) = TP: ch = ch + 1
    Next A
    sortInsertBubble3 = T
End Function

RyuAutodidacte · 10 Novembre 2023

Re @patricktoulon et tous bien sur

Le nouveaux Tris Lent accéléré par ma méthode :

M_11_TRI_BUBBLE

VB:

Option Base 1

Dim Q&
Dim ch&

Sub testQSort()
Dim TB, TA(), SortColl As New Collection, GetTA, tim!, Mn

   Cells(1, 3).Resize(10000).ClearContents
    Q = 0: ch = 0: tim = Timer
 
    n = 1: ReDim temp(1 To 1)
    TB = Cells(1).CurrentRegion.Value
    For Each t In TB
        ReDim NewTB(1 To 1)
        L = Mid(t, 1, Len(t) - 1): S = Len(t): cle = L & S
        On Error Resume Next
        SortColl.Add IIf(SortColl.Count = 0, 1, SortColl.Count + 1), cle
        If Err Then
            GetTA = TA(SortColl(cle)):  ReDim Preserve GetTA(1 To UBound(GetTA) + 1): GetTA(UBound(GetTA)) = t: TA(SortColl(cle)) = GetTA
        Else
            ReDim Preserve TA(1 To SortColl.Count): TA(SortColl(cle)) = Array(t): ReDim Preserve temp(1 To n): temp(n) = CLng(cle)
            n = UBound(temp) + 1
        End If
    Next
    ReDim TB(1 To UBound(temp))
    For i = 1 To UBound(temp)
        Mn = Application.Min(temp)
        Mn = CStr(Mn)
        TB(i) = TA(SortColl(Mn)):     temp(SortColl(Mn)) = 1E+37
    Next
 
    For i = 1 To UBound(TB): TB(i) = SortBubble(TB(i)): Q = Q + 1:: Next
 
    ReDim TA(1 To 1)
    n = 0
    For Each arr In TB
        Q = Q + 1
        ReDim Preserve TA(1 To n + UBound(arr))
        For i = 1 To UBound(arr)
            Q = Q + 1
            TA(i + n) = arr(i)
        Next
        n = UBound(TA)
    Next

    MsgBox Format(Timer - tim, "#0.00") & " sec" & vbCrLf & Q & " TOURS DE BOUCLE" & vbCrLf & ch & " INTERVERTIONS"
    Cells(1, 3).Resize(UBound(TA)) = Application.Transpose(TA)
End Sub


Function SortBubble(t) 'fonction Tri à bulle classique
    Dim temp, i&, a&
    For i = LBound(t) To UBound(t) - 1
        For a = i To UBound(t)
            Q = Q + 1
            If t(i) > t(a) Then temp = t(i): t(i) = t(a): t(a) = temp: ch = ch + 1
        Next
    Next
     SortBubble = t
End Function

M_21_TRI_INSERTION_SORT

VB:

Option Base 1

Dim Q&, ch&, P&

'Tri par insertion (Insertion sort)

Sub testQSort()
Dim TB, TA(), SortColl As New Collection, GetTA, tim!, Mn

   Cells(1, 3).Resize(10000).ClearContents
    Q = 0: ch = 0: tim = Timer
 
    n = 1: ReDim temp(1 To 1)
    TB = Cells(1).CurrentRegion.Value
    For Each t In TB
        ReDim NewTB(1 To 1)
        L = Mid(t, 1, Len(t) - 1): S = Len(t): cle = L & S
        On Error Resume Next
        SortColl.Add IIf(SortColl.Count = 0, 1, SortColl.Count + 1), cle
        If Err Then
            GetTA = TA(SortColl(cle)):  ReDim Preserve GetTA(1 To UBound(GetTA) + 1): GetTA(UBound(GetTA)) = t: TA(SortColl(cle)) = GetTA
        Else
            ReDim Preserve TA(1 To SortColl.Count): TA(SortColl(cle)) = Array(t): ReDim Preserve temp(1 To n): temp(n) = CLng(cle)
            n = UBound(temp) + 1
        End If
    Next
    ReDim TB(1 To UBound(temp))
    For i = 1 To UBound(temp)
        Mn = Application.Min(temp)
        Mn = CStr(Mn)
        TB(i) = TA(SortColl(Mn)):     temp(SortColl(Mn)) = 1E+37
    Next
 
    For i = 1 To UBound(TB): TB(i) = SortInsertion1(TB(i)): Q = Q + 1:: Next
 
    ReDim TA(1 To 1)
    n = 0
    For Each arr In TB
        Q = Q + 1
        ReDim Preserve TA(1 To n + UBound(arr))
        For i = 1 To UBound(arr)
            Q = Q + 1
            TA(i + n) = arr(i)
        Next
        n = UBound(TA)
    Next

    MsgBox Format(Timer - tim, "#0.00") & " sec" & vbCrLf & Q & " TOURS DE BOUCLE" & vbCrLf & ch & " INTERVERTIONS"
    Cells(1, 3).Resize(UBound(TA)) = Application.Transpose(TA)
End Sub

Function SortInsertion1(t)
    Dim temp, i&, a&
    For i = LBound(t) + 1 To UBound(t)
        For a = LBound(t) To i - 1
            If t(i) < t(a) Then TP = t(i): t(i) = t(a): t(a) = TP: ch = ch + 1
            Q = Q + 1
        Next
    Next
    SortInsertion1 = t
End Function

M_31_TRI_HYBRIDE_iNSERT_BUBBLE

VB:

Option Base 1

Dim Q
Dim ch

Sub testQSort()
Dim TB, TA(), SortColl As New Collection, GetTA, tim!, Mn
   Cells(1, 3).Resize(10000).ClearContents
    Q = 0: ch = 0: tim = Timer
 
    n = 1: ReDim temp(1 To 1)
    TB = Cells(1).CurrentRegion.Value
    For Each t In TB
        ReDim NewTB(1 To 1)
        L = Mid(t, 1, Len(t) - 1): S = Len(t): cle = L & S
        On Error Resume Next
        SortColl.Add IIf(SortColl.Count = 0, 1, SortColl.Count + 1), cle
        If Err Then
            GetTA = TA(SortColl(cle)):  ReDim Preserve GetTA(1 To UBound(GetTA) + 1): GetTA(UBound(GetTA)) = t: TA(SortColl(cle)) = GetTA
        Else
            ReDim Preserve TA(1 To SortColl.Count): TA(SortColl(cle)) = Array(t): ReDim Preserve temp(1 To n): temp(n) = CLng(cle)
            n = UBound(temp) + 1
        End If
    Next
    ReDim TB(1 To UBound(temp))
    For i = 1 To UBound(temp)
        Mn = Application.Min(temp)
        Mn = CStr(Mn)
        TB(i) = TA(SortColl(Mn)):     temp(SortColl(Mn)) = 1E+37
    Next
 
    For i = 1 To UBound(TB): TB(i) = sortInsertBubble(TB(i)): Q = Q + 1:: Next
 
    ReDim TA(1 To 1)
    n = 0
    For Each arr In TB
        Q = Q + 1
        ReDim Preserve TA(1 To n + UBound(arr))
        For i = 1 To UBound(arr)
            Q = Q + 1
            TA(i + n) = arr(i)
        Next
        n = UBound(TA)
    Next

    MsgBox Format(Timer - tim, "#0.00") & " sec" & vbCrLf & Q & " TOURS DE BOUCLE" & vbCrLf & ch & " INTERVERTIONS"
    Cells(1, 3).Resize(UBound(TA)) = Application.Transpose(TA)
End Sub
Function sortInsertBubble(t)
    Dim a&, b&, C&, x&, D&, Z&, ref, refD
    For a = LBound(t) To UBound(t)
        ref = t(a): refD = t(a)
        x = a
        For b = a + 1 To (UBound(t))
            Q = Q + 1
            If ref > t(b) Then ref = t(b): x = b:
      
        Next b
        If x <> a Then TP = t(a): t(a) = t(x): t(x) = TP: ch = ch + 1
    Next a
    sortInsertBubble = t
End Function

PS : Rappel : je t'avais dit sur un autre post que j'avais mis en Option Base 1 car j'avais des Array base 0
ce qui faussait la donne, donc en attendant de trouver le pourquoi du comment, j'ai laissé Option Base 1
Je suppose que si le problème est réglé et que l'on peut enlevé Option base 1 on devrait peut être y gagner un chouia de temps

Sinon l'histoire ne s'arrête pas là afin de tout verrouiller de le faire aussi bien sur des lettres que des chiffres sans que cela pose Problème

On va appeler cela (le principe créer) :
L'Accélérateur de Tris RYU (pour les tris lents)

patricktoulon · 10 Novembre 2023

re
Bonjour ryu
les 3 entre 0.65 et 0.80 sur 10 000 titems

RyuAutodidacte · 10 Novembre 2023

Re
Un grand bon pour les 2 autres ;

patricktoulon · 10 Novembre 2023

re
avec ta premiere version et ma insertionbubbleGD
je suis decendu a 0.40/0.45

VB:

'******************************************************************************************************************************************************
'    __    _  _  _   _  _       _   _ _______  ___     ___     _  ___     _       ____ _______  ____
'   // \\ // // //  // /\\     //  //   //    //  \\  // ||   // // ||   /\\     //      //    //
'  //__// \\// //  // //__\   //  //   //    //   // //  ||  // //  ||  //__\   //      //    //__
' //  \\   // //  // //   \\ //  //   //    //   // //   // // //   // //   \\ //      //    //
'//   //  // //__// //    ////__//   //     \\__// //___// // //___// //    ////___   //    //___
'******************************************************************************************************************************************************
'méthode 6
'Auteur: Ryuautodidacte et patricktoulon sur ExcelDownloads
'version1 1.0
'réécrite en une seule fonction par patricktoulon
'insertion des code sortinsertbubble intra code
' cette fonction reside sur le fait d'utiliser un object collection qui va contenir dans les valeur un array de chaine similaire
'ou commencant par les meme caractères
'ensuite on va trier chaque sub array avec la méthode sortinsertbubble de patricktoulon
'ensuite on va refaire une passe sortinserbubble sur le TAg général (qui contioent des sub arrary)
'et le trier par la valeur du premier item de chaque array
'et pour finir on recompile les sub array dans un seul tableau (celui d'origine )
'
'vous l'avez compris on est dans la catégorie de fonction de tri dite "Diviser pour mieux reigner"
'en effet les boucles sont moins longues et plus rapide a trier
'mis apart l'object collection on est tres proche de la méthode fusion coisée avec l'insertion
'*****************************************************************************************************
Option Base 1
Dim Q
Dim ch
Sub test()
    Dim TB, tim#
    Q = 0: ch = 0
    TB = Cells(1).CurrentRegion.Value
    Cells(1, 3).Resize(UBound(TB)).ClearContents
    tim = Timer
    TB = SortRyuPatKey(TB)
    MsgBox Format(Timer - tim, "#0.00") & " sec" & vbCrLf & Q & " TOURS DE BOUCLE" & vbCrLf & ch & " INTERVERTIONS"
    Cells(1, 3).Resize(UBound(TB)) = (TB)

End Sub

Function SortRyuPatKey(TB)
    Dim TA(), SortColl As New Collection, GetTA, Tmps!, L, a&, b&, x&, ref, SubTB, SubTBA, D&, W&

    For Each t In TB
        ReDim NewTB(1 To 1)
        L = Mid(t, 1, Len(t) - 1): S = Len(t): cle = L & "|" & S
        On Error Resume Next
        SortColl.Add IIf(SortColl.Count = 0, 1, SortColl.Count + 1), cle
        If Err Then
            GetTA = TA(SortColl(cle)): ReDim Preserve GetTA(1 To UBound(GetTA) + 1): GetTA(UBound(GetTA)) = t: TA(SortColl(cle)) = GetTA
        Else
            ReDim Preserve TA(1 To SortColl.Count): TA(SortColl(cle)) = Array(t)
        End If
    Next

    'tri SortInsertBubbleGD des sub array dans l'array TA
    For i = 1 To UBound(TA)
        SubTB = TA(i)
        For a = LBound(SubTB) To UBound(SubTB)
            ref = SubTB(a)
            x = a
            D = UBound(TA)
            W = (UBound(TA) - a) / 2
            For b = a + 1 To (UBound(SubTB) - W)
                Q = Q + 1
                If ref > SubTB(b) Then ref = SubTB(b): x = b:
                If ref > SubTB(D) Then ref = SubTB(D): x = D:
                D = D - 1
            Next b
            If x <> a Then TP = SubTB(a): SubTB(a) = SubTB(x): SubTB(x) = TP: ch = ch + 1
        Next a
        TA(i) = SubTB
        Q = Q + 1
    Next

    ' second tri sortinsertbubble sur le TA genéral
    ' le tri va se faire sur le premier item de chaque array dans subTBA
    SubTBA = TA
    For a = LBound(SubTBA) To UBound(SubTBA)
        ref = SubTBA(a)(1)
        x = a
        For b = a + 1 To (UBound(SubTBA))
            Q = Q + 1
            If ref > SubTBA(b)(1) Then ref = SubTBA(b)(1): x = b:

        Next b
        If x <> a Then TP = SubTBA(a): SubTBA(a) = SubTBA(x): SubTBA(x) = TP: ch = ch + 1
    Next a
    TA = SubTBA

    ReDim TB(1 To 1)
    n = 0
    For Each arr In TA
        Q = Q + 1
        ReDim Preserve TB(1 To n + UBound(arr))
        For i = 1 To UBound(arr)
            Q = Q + 1
            TB(i + n) = arr(i)
        Next
        n = UBound(TB)
    Next
    SortRyuPatKey = Application.Transpose(TB)
End Function

Effectuez une recherche sur Excel Downloads...

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

patricktoulon

XLDnaute Barbatruc

Pièces jointes

patricktoulon

patricktoulon

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

RyuAutodidacte

XLDnaute Impliqué

patricktoulon

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

RyuAutodidacte

XLDnaute Impliqué

patricktoulon

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

RyuAutodidacte

XLDnaute Impliqué

patricktoulon

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

RyuAutodidacte

XLDnaute Impliqué

patricktoulon

XLDnaute Barbatruc

RyuAutodidacte

XLDnaute Impliqué

patricktoulon

XLDnaute Barbatruc

Membres actuellement en ligne

Partager cette page

Tutos vidéos

Statistiques des forums