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
    If g <=...

mapomme

XLDnaute Barbatruc
Supporter XLD
Bonsoir @Magic_Doctor :),

S'il n'y a pas trop d'élément, on peut utiliser:
VB:
Sub test()
Dim liste, ech As Boolean, i&, aux
liste = Array("jaune", "vert", "orange", "blanc", "rouge", "noir", "fuchsia", "marron")
   Do
      ech = False
      For i = 0 To UBound(liste) - 1
         If liste(i) > liste(i + 1) Then ech = True: aux = liste(i): liste(i) = liste(i + 1): liste(i + 1) = aux
      Next i
   Loop Until ech = False
   MsgBox Join(liste, vbLf)
End Sub

nota : ce tri est stable
 
Dernière édition:

laurent950

XLDnaute Accro
Bonsoir,
Au choix :

VB:
  ' Croissant
        ' croissant a, g, ref, d
  ' Ou
  '
  ' Décroissant
        ' décroissant a, g, ref, d
  '

VB:
pour afficher le contenu du tableau dans une MsgBox
MsgBox Join(liste, vbLf)

Le code :

Code:
Sub test()
    Dim Liste As Variant
    Liste = Array("jaune", "vert", "orange", "blanc", "rouge", "noir", "fuchsia", "marron")
    '
    ' Choisir croissant (Pour le tri)
    tri Liste, LBound(Liste), UBound(Liste)
    MsgBox Join(liste, vbLf)
End Sub
'
Sub tri(a As Variant, gauc, droi)  ' Quick sort
  ref = a((gauc + droi) \ 2)
  g = gauc: d = droi
  Do
  '
  ' Choix du tri avec appel de la fonction ci-dessous :
  ' ------------------------------------------------------
  '
  ' Croissant
         croissant a, g, ref, d
  '
  ' Ou
  '
  ' Décroissant
        ' décroissant a, g, ref, d
  '
    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)
    If gauc < d Then Call tri(a, gauc, d)
End Sub
'
Sub croissant(a, g, ref, d)
' Pour un tri croissant
    Do While a(g) < ref: g = g + 1: Loop
    Do While ref < a(d): d = d - 1: Loop
End Sub
'
Sub décroissant(a, g, ref, d)
' Pour un tri décroissant
    Do While a(g) > ref: g = g + 1: Loop
    Do While ref > a(d): d = d - 1: Loop
End Sub
 
Dernière édition:

mapomme

XLDnaute Barbatruc
Supporter XLD
Re,

Pour le fun, une méthode qui fonctionne aussi pour nos amis à la pomme.
Une procédure Trier qui s'emploie comme suit: Trier maListemaliste est la liste (array) à une dimension qu'il faut trier. On utilise une feuille auxiliaire.
Le code de la Sub trier est dans module1.

Pour une liste de 1 000 000 éléments, sur ma bécane, ça prend entre 2,2 et 2,4 secondes.

Il n'y a pas de meilleur algo de tri. il faut savoir ce qu'on trie, l'ordre de grandeur du nombre d'éléments, si la liste de départ est très "mélangée" ou non, si on veut un tri stable (pour un array à une dimension c'est inutile), si on veut ou non économiser de la mémoire, etc. C'est compliqué les tris.
 

Pièces jointes

  • Magic_Doctor- tri le million- v1.xlsm
    23.2 KB · Affichages: 34
Dernière édition:

patricktoulon

XLDnaute Barbatruc
Bonjour
J'ai cru comprendre que pour Access il y avait Array.Sort pour régler ce type de problème. Curieusement pour Excel il n'y a pas d'équivalent.
pour répondre a cette question :

il y a en fait 2 objects utilisables en vba (Uniquement Windows)qui possèdent l'auto sort ou le . sort mais il ont la réputation d’être lourds
ces object sont respectivement
le "ArrayList" possède la fonction interne ".sort"
le " sortedlist" auto sort ( semblable au dictionnaire(key/item) mais avec le sort en plus)

utilisation en late binding de arraylist
Code:
Set arrs = CreateObject("System.Collections.ArrayList")

VB:
set dicoOrder= CreateObject("System.Collections.SortedList")
demonstration avec l'arraylist
VB:
Sub test()
    liste = Array("blanc", "marron", "fuchsia", "rouge", "jaune", "noir", "orange", "vert")
    liste2 = sortedarray(liste)
    MsgBox Join(liste2)

End Sub

Function sortedarray(tbl)
    Dim arrs As Object
    Set arrs = CreateObject("System.Collections.ArrayList")
    With arrs:
        For i = LBound(tbl) To UBound(tbl): .Add tbl(i): Next
        .Sort'on tri
    End With
    sortedarray = arrs.toarray
End Function
étant donné qu'il sont plus lourds en system à l'inverse pour des liste très longues il peuvent s’avérer plus rapides

METHODE 2
après dans le même ordre que le l'exemple(1) de @mapomme
la double boucle imbriqué
VB:
Sub testAvecArray()
    liste = Array("blanc", "marron", "fuchsia", "rouge", "jaune", "noir", "orange", "vert")
    listordre = simplyarrSort(liste)
    MsgBox Join(listordre, ",")
End Sub

Function simplyarrSort(tbl)
    Dim I&, E&
     For I = LBound(tbl) To UBound(tbl)
        For E = I + 1 To UBound(tbl) - 1
            If tbl(E) < tbl(I) Then temp = tbl(I): tbl(I) = tbl(E): tbl(E) = temp
        Next
    Next
    simplyarrSort = tbl
End Function
 
Dernière édition:

dysorthographie

XLDnaute Accro
bonjour Magic_Doctor,mapomme,laurent950 et Patrick,
personnellement je préfère une simple boucle incrémentale décrémentale à une double boucle!
VB:
Function simplyarrSort(tbl)
    Dim I&
    For I = LBound(tbl) + 1 To UBound(tbl)
        If tbl(I) < tbl(I - 1) Then
            temp = tbl(I - 1): tbl(I - 1) = tbl(I): tbl(I) = temp
            I = I - 2
            If I < 0 Then I = 0
        End If
    Next
    simplyarrSort = tbl
End Function
 

dysorthographie

XLDnaute Accro
VB:
Sub testAvecArray()
    liste = Array("blanc", "marron", "fuchsia", "rouge", "jaune", "noir", "orange", "vert")
    
Debug.Print Join(simplyarrSort(liste), ";"), Join(simplyarrSort(liste, True), ";")
End Sub
Function simplyarrSort(tbl, Optional Decrm As Boolean = False)
    Dim I&
    For I = LBound(tbl) + 1 To UBound(tbl)
        If tbl(I + Decrm) < tbl(I + Not Decrm) Then
            temp = tbl(I + Not Decrm): tbl(I + Not Decrm) = tbl(I + Decrm):   tbl(I + Decrm) = temp
            I = I - 2
            If I < 0 Then I = 0
        End If
    Next
    simplyarrSort = tbl
End Function
 

mapomme

XLDnaute Barbatruc
Supporter XLD
personnellement je préfère une simple boucle incrémentale décrémentale à une double boucle!
Bonjour @dysorthographie :)
Par principe, je ne touche jamais à l'indice d'une boucle for i =... dans la boucle. D'ailleurs certains langages ne l'autorisent pas. Modifier l'indice de boucle rend la boucle incompréhensible selon moi.
A quoi sert d'écrire logiquement For i = 1 to max step 1 quand dans la boucle i varie n'importe comment.
Je ne vois pas pourquoi une double boucle serait néfaste.
 

Discussions similaires