XL 2010 Trier, en VBA, un Array par ordre alphabétique

Magic_Doctor

XLDnaute Barbatruc
Bonjour,

Je me heurte à un problème apparemment simple.
J'ai un Array :
Liste = Array("jaune", "vert", "orange", "blanc", "rouge", "noir", "fuchsia", "marron")

Comment le trier par odre alphabétique, afin d'obtenir :
Liste = Array("blanc", "fuchsia","jaune", "marron", "noir", "orange", "rouge", "vert")

Merci d'avance pour toute réponse.
 
Solution
Cela dit en VBA on s'en sort très bien en utilisant 2 tableaux a et b, fichier (2) :
VB:
Private Sub Combobox1_GotFocus()
Dim a, b, x%
a = Array("jaune", "vert", "guaraní", "georgien", "rouge", "noir", "fuchsia", "marron") 'tableau à une dimension sans accents et en minuscules, à adapter
b = Array("jaune", "vert", "Guaraní", "Géorgien", "rouge", "noir", "fuchsia", "marron") 'tableau à une dimension avec accents, à adapter
tri a, b, 0, UBound(a)
ComboBox1.List = b 'liste avec accents
ComboBox1.DropDown 'déroule la liste
End Sub

Sub tri(a, b, gauc, droi) ' Quick sort
Dim ref, g, d, temp
ref = a((gauc + droi) \ 2)
g = gauc: d = droi
Do
    Do While a(g) < ref: g = g + 1: Loop
    Do While ref < a(d): d = d - 1: Loop...

dysorthographie

XLDnaute Occasionnel
Je ne vois pas pourquoi une double boucle serait néfaste.
je n'es pas parlé de néfaste; mais personnellement!

notes que le maximum de désordre est de 50% vu qu'au pire on interverti Z et A!

une double boucle sous entent un désordre de 100% même quand le tableau est parfaitement trié (ubound X ubound ) - ubound !

c'est juste mon opinion et ça n'engage que moi!

ta proposition du poste #2 permet un boucle coute si le tableau est bien ordonnées.
S'il n'y a pas trop d'élément,

Robert c'est moi, avec Patrick on a un long chemin en commun!

je suis venu sur ce site car j'ai vu que Patrick y était!
 
Dernière édition:

patricktoulon

XLDnaute Barbatruc
re
Bon
après tout les test
dans l'ordre de la plus rapide a la plus lente
  1. méthode @mapomme (utilisation des fonction de la feuille) sur un million d'item 5.356 sec
  2. méthode @patricktoulon avec l'object Arraylist sur un million d'items 9.54 sec
pour les autre çà dépasse les 15 minutes sur un million de lignes j'ai du forcer l'arrêt

j'ai donc descendue le nombre d'item à 10 000

3. méthode @patricktoulon double boucle imbriquée sur 10 000 items 10.369 sec
4. méthode @dysorthographie simple boucle decrm ou pas sur 10 000 lignes 12.564 sec

testé 10 fois en vidant la mémoire

et oui désolé robert a ma grande surprise tu a la plus lente
la double boucle bas donc (de peu certes )la simple boucle avec jump

conclusion :
comme j'ai dis plus haut et en faisant abstraction de la méthode @mapomme sur feuille
l'object ArrayList en pur vba!!! s'avère le plus rapide (sur un plus grand nombre d'items) que toute autre méthode même le Quik sort (@laurent950) est loin derrière

voili voilou ;)
 

patricktoulon

XLDnaute Barbatruc
re
un Grand plus quand même pour @laurent950 qui à désorganisé et sectionné cette macro bien connue
pour avoir croissant/décroissant en optionel
après nettoyage du code elle devient(surprise surprise )!!!! la 1ere méthode la plus rapide 5.106 sec sur 1 million d'items
ensuit ma pomme avec sa méthode sur feuille 5.333 sec
et j'arrive donc en 3eme position avec mon arrayList avec mes 9.52 sec
bravo laurent pour une fois c'est toi qui gagne ;) 🤣tu va même plus vite qu'excel
ta fonction en une
0 pour croissant et 1 pour décroissant pour le dernier argument
VB:
Sub test()
    Dim Liste As Variant
    Liste = Array("jaune", "vert", "orange", "blanc", "rouge", "noir", "fuchsia", "marron")
      tri Liste, LBound(Liste), UBound(Liste), 0
    MsgBox Join(Liste, vbLf)
End Sub

Sub testy2()
    Dim Liste(0 To 999999), i&, t(0 To 999999, 1 To 1)
    Randomize
    For i = 0 To 999999: Liste(i) = Int(Rnd * 75000): t(i, 1) = Liste(i): Next
    MsgBox "départ"
    tim = Timer
    tri Liste, LBound(Liste), UBound(Liste), 0
    MsgBox Format(Timer - tim, "#0.000 /sec") & " pour le tri " & Join(Liste, ",")
End Sub


'
Sub tri(a As Variant, gauc, droi, optional sens As Long=0)  ' Quick sort
    ref = a((gauc + droi) \ 2)
    g = gauc: d = droi
    Do
        'choix du sens
        Select Case sens
        Case 0
            ' Pour un tri croissant
            Do While a(g) < ref: g = g + 1: Loop
            Do While ref < a(d): d = d - 1: Loop
        Case 1
            ' Pour un tri décroissant
            Do While a(g) > ref: g = g + 1: Loop
            Do While ref > a(d): d = d - 1: Loop
        End Select

        If g <= d Then
            temp = a(g): a(g) = a(d): a(d) = temp
            g = g + 1: d = d - 1
        End If
    Loop While g <= d
    If g < droi Then Call tri(a, g, droi, sens)
    If gauc < d Then Call tri(a, gauc, d, sens)
End Sub
 

patricktoulon

XLDnaute Barbatruc
re
en fait il y est mais les clés sont supprimées avec l'instalation framework 4.x

vérifier les clés (présence)
[HKEY_LOCAL_MACHINE\SOFTWARE\Classes\CLSID\{6896B49D-7AFB-34DC-934E-5ADD38EEEE39}]
@="System.Collections.ArrayList"

[HKEY_LOCAL_MACHINE\SOFTWARE\Classes\CLSID\{6896B49D-7AFB-34DC-934E-5ADD38EEEE39}\Implemented Categories]

[HKEY_LOCAL_MACHINE\SOFTWARE\Classes\CLSID\{6896B49D-7AFB-34DC-934E-5ADD38EEEE39}\Implemented Categories\{62C8FE65-4EBB-45E7-B440-6E39B2CDBF29}]

[HKEY_LOCAL_MACHINE\SOFTWARE\Classes\CLSID\{6896B49D-7AFB-34DC-934E-5ADD38EEEE39}\InprocServer32]
"Class"="System.Collections.ArrayList"
"ThreadingModel"="Both"
@="mscoree.dll"

[HKEY_LOCAL_MACHINE\SOFTWARE\Classes\CLSID\{6896B49D-7AFB-34DC-934E-5ADD38EEEE39}\InprocServer32\2.0.0.0]
"Class"="System.Collections.ArrayList"
"RuntimeVersion"="v2.0.50727"
"Assembly"="mscorlib, Version=2.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089"

[HKEY_LOCAL_MACHINE\SOFTWARE\Classes\CLSID\{6896B49D-7AFB-34DC-934E-5ADD38EEEE39}\ProgId]
@="System.Collections.ArrayList"
et celle ci
[HKEY_LOCAL_MACHINE\SOFTWARE\Classes\System.Collections.ArrayList]
@="System.Collections.ArrayList"

[HKEY_LOCAL_MACHINE\SOFTWARE\Classes\System.Collections.ArrayList\CLSID]
@="{6896B49D-7AFB-34DC-934E-5ADD38EEEE39}"
;)
 

patricktoulon

XLDnaute Barbatruc
re
de rien Laurent
oui et bizarrement plus rapide alors que je n'ai fait que déplacer des instructions
c'est peut être le fait que le min max était dans une sub appelée (je vois que ça )

Attention étant donné que j'ai ajouté un argument
tout les appels récursifs doivent l'avoir aussi par contre OBLIGATOIREMENT!!!!
même si il est optionel et que pour le premier appel je peu m'en passer pour le "croissant"
If g < droi Then Call tri(a, g, droi, sens)
If gauc < d Then Call tri(a, gauc, d, sens)
avec ce conditionnement je serai curieux de le voir fonctionner en tant que fonction et donc d'utiliser un return (perso je préférerais ) ;)
 

Discussions similaires

Haut Bas