Fonction de tri d'une variable tableau en VBA

S

Sparrow

XLDnaute Nouveau
Bonjour,

Je recherche si une fonction de tri est applicable à une variable tableau défini par le mot clé DIM en VBA Excel 2010.

J'ai tenté le code suivant :
Sub SortDemo()
Dim a(10), l(10)
a(1) = "N"
a(2) = "A"
a(3) = "T"
a.Sort
End Sub

A l'exécution, une erreur survient : Erreur de compilation - Qualificateur incorrect.
D'où ma question : existe-t-il une fonction qui permet de trier le tableau a et quelle est sa syntaxe ?

Merci.
 
Dernière édition:
Trier par date Trier par votes
Dranreb

Dranreb

XLDnaute Barbatruc
Re : Fonction de tri d'une variable tableau en VBA

Bonjour.

J'ai un module de classe qui ne reclasse pas la table elle même mais fabrique une table des numéros de lignes rangés dans l'ordre ou il faut y accéder pour la parcourir dans l'ordre de classement. Il a de nombreuses applications.
 
Dernière édition:
Vote positif 0 Vote négatif
BOISGONTIER

BOISGONTIER

XLDnaute Barbatruc
Repose en paix
Re : Fonction de tri d'une variable tableau en VBA

Bonjour,

Tri d'un tableau

Code: 
Sub TriQuick()
  n = 10000          ' 0,04 sec
  Dim temp() As Double
  ReDim temp(1 To n)
  For i = 1 To n
    temp(i) = Rnd
  Next i
  t = Timer
  Call tri(temp, 1, n)
  MsgBox Timer - t
  [A1].Resize(n) = Application.Transpose(temp)
End Sub

Sub tri(a() As Double, gauc, droi) ' Quick sort
  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 <= 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

Tri tableau à 2 dimensions

JB
 
Dernière édition:
Vote positif 0 Vote négatif
D

david84

XLDnaute Barbatruc
Re : Fonction de tri d'une variable tableau en VBA

Bonjour,
Un petit test via l'utilisation de l'objet ArrayList :
Code: 
Sub SortDemo()
Dim AL As Object
Set AL = CreateObject("System.Collections.ArrayList")
AL.Add "N"
AL.Add "A"
AL.Add "T"
MsgBox Join(AL.toarray())
AL.Sort 'on trie
MsgBox Join(AL.toarray())
End Sub
A+
 
Vote positif 0 Vote négatif
Paf

Paf

XLDnaute Barbatruc
Re : Fonction de tri d'une variable tableau en VBA

bonjour à tous

une version moins "excellienne" :

Code: 
Sub SortDemo()
Dim a() ', l(10)
Dim i As Byte, j As Byte, temp As String, Tri As Boolean

ReDim a(1)

a(1) = "N"
ReDim Preserve a(UBound(a) + 1)
a(2) = "A"
ReDim Preserve a(UBound(a) + 1)
a(3) = "T"
ReDim Preserve a(UBound(a) + 1)
a(4) = "Z"
ReDim Preserve a(UBound(a) + 1)
a(5) = "B"
ReDim Preserve a(UBound(a) + 1)
a(6) = "E"
ReDim Preserve a(UBound(a) + 1)
a(7) = "X"
ReDim Preserve a(UBound(a) + 1)
a(8) = "C"
ReDim Preserve a(UBound(a) + 1)
a(9) = "Y"
'a.Sort
For i = 1 To UBound(a)
    Tri = False
    For j = 1 To UBound(a) - 1
        If a(j) > a(j + 1) Then
            temp = a(j)
            a(j) = a(j + 1)
            a(j + 1) = temp
            temp = ""
            Tri = True
        End If
    Next
    If Tri = False Then
        Exit For
    End If
    
Next

End Sub

bonne journée
 
Vote positif 0 Vote négatif
BOISGONTIER

BOISGONTIER

XLDnaute Barbatruc
Repose en paix
Re : Fonction de tri d'une variable tableau en VBA

Comparaison ArrayList et QuickSort

Pour 10.000 chaines , on trouve 0,18s et 0,10s (la différence provient de l'alimentation de ArrayList)


Code: 
Sub SortDemoArrayList()
t = Timer()
Dim AL As Object
Set AL = CreateObject("System.Collections.ArrayList")
a = [A2:A10000].Value
For i = 2 To 9999
   AL.Add a(i, 1)
Next i
AL.Sort 'on trie
[d2:d10000].Value = Application.Transpose(AL.toarray)
MsgBox Timer - t
End Sub

Sub SortDemoQuick()
  t = Timer()
  a = [A2:A10000].Value
  n = 9999
  Dim temp() As String
  ReDim temp(1 To n)
  For i = 1 To n
    temp(i) = a(i, 1)
  Next i
  Call tri(temp, 1, n)
  [d2:d10000].Value = Application.Transpose(temp)
  MsgBox Timer - t
End Sub

Sub tri(a() As String, gauc, droi) ' Quick sort
  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 <= 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

JB
 

Pièces jointes

  • TriArray.zip
    330.6 KB · Affichages: 67
Dernière édition:
Vote positif 0 Vote négatif
S

Sparrow

XLDnaute Nouveau
Re : Fonction de tri d'une variable tableau en VBA

Je suis épaté par la vitesse à laquelle vous m'avez répondu : à peine le temps d'aller déjeuner :cool: !

david 84, j'ai testé ton code et il marche impec !

Mais, pourrais-tu le commenter et me dire comment retrouver ma variable a initiale ?

Cette solution fonctionne-t-elle aussi avec un tableau à plusieurs dimensions, du type DIM tab (100, 2, 2) ?

Merci à tous :) .

Sparrow
 
Vote positif 0 Vote négatif
Dranreb

Dranreb

XLDnaute Barbatruc
Re : Fonction de tri d'une variable tableau en VBA

J'ai développé de nombreux modules autour du module de classe TableIndex. le plus surprenant est la création de dictionnaires arborescents. Il y en a bien sûr un qui permet de reproduire une version classée d'un tableau de Variant sur plusieurs arguments possibles, chacun en ordre croissant ou décroissant. Ce module comporte depuis peu une fonction GroupOrg qui fabrique une collection de collections de collections… Elle vous décharge des problème de test de ruptures de séquences en les ayant tous fait à votre place. Il ne reste plus qu'à imbriquer les For Each Livre In Bibliothèque.Contenu, For Each Chapitre In Livre.Contenu etc. Et vous avez à chaque niveau la Livre.Id, Chapitre.Id etc. Le dernier niveau est un tableau à une seule dimension reproduisant les valeurs de la ligne.
 
Vote positif 0 Vote négatif
D

david84

XLDnaute Barbatruc
Re : Fonction de tri d'une variable tableau en VBA

Mais, pourrais-tu le commenter et me dire comment retrouver ma variable a initiale ?

Cette solution fonctionne-t-elle aussi avec un tableau à plusieurs dimensions, du type DIM tab (100, 2, 2) ?
Cliquez pour agrandir...
A ma connaissance le ArrayList traite des tableaux unidimensionnels.
Comparaison ArrayList et QuickSort

Pour 10.000 chaines , on trouve 0,18s et 0,10s (la différence provient de l'alimentation de ArrayList)
Cliquez pour agrandir...
Merci pour les tests Jacques. Au-delà de la vitesse de traitement, je note surtout des différences sur les résultats obtenus.
Il faudrait voir ce que cela donne sur d'autres données (les dates par exemple) pour comparer.
A+
 

Pièces jointes

  • Compare_QuickSort_ArrayList.xls
    40.5 KB · Affichages: 63
  • Compare_QuickSort_ArrayList.xls
    40.5 KB · Affichages: 63
  • Compare_QuickSort_ArrayList.xls
    40.5 KB · Affichages: 65
Vote positif 0 Vote négatif
BOISGONTIER

BOISGONTIER

XLDnaute Barbatruc
Repose en paix
Re : Fonction de tri d'une variable tableau en VBA

@David

Il manque Option Compare Text

Code: 
Option Compare Text

Sub SortDemoQuick()
Dim a(), n&, i&
  a = Range("A2:A17").Value
  n = UBound(a)
  Dim temp() As String
  ReDim temp(1 To n)
  For i = 1 To n
    temp(i) = a(i, 1)
  Next i
  Call tri(temp, 1, n)
  Range("D2:D17").Value = Application.Transpose(temp)
End Sub

Compléments sur ArrayList

Code: 
Option Explicit
Sub ptest()
     'http://www.robvanderwoude.com/vbstech.php#Data
     'http://www.thecodecage.com/forumz/showthread.php?p=1055000938#post1055000938
    Dim myArrayList As Object, myArrayList2 As Object
    Dim xItem, myrange
    Set myArrayList = CreateObject("System.Collections.ArrayList")
    myArrayList.Add "Kyle"
    myArrayList.Add "123"
    myArrayList.Add "C"
    myArrayList.Add "snb"
    myArrayList.Add "pike"
    Set myArrayList2 = myArrayList.Clone
    myArrayList.Add "Z"
    myArrayList.Remove "C"
    [j1] = Join(myArrayList.toarray(), Chr(10))
    [K1] = "List Has C " & myArrayList.Contains("C")
    [L1] = "List Has Z " & myArrayList.Contains("Z")
    [M1] = "Size     : " & myArrayList.Count
    [N1] = "Capacity : " & myArrayList.Capacity
    myArrayList.TrimToSize
    [O1] = "Size     : " & myArrayList.Count
    [P1] = "Capacity : " & myArrayList.Capacity
    myArrayList.Sort
    [q1] = Join(myArrayList.toarray(), Chr(10))
    myArrayList.Reverse
    [R1] = Join(myArrayList.toarray(), Chr(10))
    [S1] = Join(myArrayList2.toarray(), Chr(10))
    Range("B1").Resize(myArrayList.Count) = Application.Transpose(myArrayList.toarray())
    Range("C1").Resize(1, myArrayList.Count) = myArrayList.toarray()
    [B10] = myArrayList(1)
    Set myArrayList = Nothing
    Set myArrayList2 = Nothing
End Sub

JB
 

Pièces jointes

  • Copie de Compare_QuickSort_ArrayList.xls
    37.5 KB · Affichages: 66
Dernière édition:
Vote positif 0 Vote négatif
D

david84

XLDnaute Barbatruc
Re : Fonction de tri d'une variable tableau en VBA

Il manque Option Compare Text
Cliquez pour agrandir...
Effectivement ! Il n'en reste pas moins que le résultat obtenu diffère légèrement malgré l'ajout de Option Compare Text.
Visiblement l'utilisation des majuscules entraîne des différences de traitement.
A+
 

Pièces jointes

  • Compare_QuickSort_ArrayList.xls
    32 KB · Affichages: 70
  • Compare_QuickSort_ArrayList.xls
    32 KB · Affichages: 80
  • Compare_QuickSort_ArrayList.xls
    32 KB · Affichages: 90
Vote positif 0 Vote négatif
D

david84

XLDnaute Barbatruc
Re : Fonction de tri d'une variable tableau en VBA

Compléments sur ArrayList

Code :
Option Explicit
Sub ptest()
'http://www.robvanderwoude.com/vbstech.php#Data
'http://www.thecodecage.com/forumz/showthread.php?p=1055000938#post1055000938
Dim myArrayList As Object, myArrayList2 As Object
Dim xItem, myrange
Set myArrayList = CreateObject("System.Collections.ArrayList")
myArrayList.Add "Kyle"
myArrayList.Add "123"
myArrayList.Add "C"
myArrayList.Add "snb"
myArrayList.Add "pike"
Set myArrayList2 = myArrayList.Clone
myArrayList.Add "Z"
myArrayList.Remove "C"
[j1] = Join(myArrayList.toarray(), Chr(10))
[K1] = "List Has C " & myArrayList.Contains("C")
[L1] = "List Has Z " & myArrayList.Contains("Z")
[M1] = "Size : " & myArrayList.Count
[N1] = "Capacity : " & myArrayList.Capacity
myArrayList.TrimToSize
[O1] = "Size : " & myArrayList.Count
[P1] = "Capacity : " & myArrayList.Capacity
myArrayList.Sort
[q1] = Join(myArrayList.toarray(), Chr(10))
myArrayList.Reverse
[R1] = Join(myArrayList.toarray(), Chr(10))
[S1] = Join(myArrayList2.toarray(), Chr(10))
Range("B1").Resize(myArrayList.Count) = Application.Transpose(myArrayList.toarray())
Range("C1").Resize(1, myArrayList.Count) = myArrayList.toarray()
[B10] = myArrayList(1)
Set myArrayList = Nothing
Set myArrayList2 = Nothing
End Sub
Cliquez pour agrandir...

Oui Jacques, j'étais tombé sur ce code.

Peut-être une autre piste intéressante à creuser avec l'objet Sortedlist permettant également le tri via les clés lorsque l'on a des items comportant une clé et une valeur :
Code: 
Sub SortedList()
Dim objSortedList As Object
Dim objList2 As Object
Dim i As Integer
 
Set objSortedList = CreateObject("System.Collections.Sortedlist")
 
objSortedList.Add "First", "AAAA"
objSortedList.Add "Second", "BBBB"
objSortedList.Add "Third", "CCCC"
objSortedList.Add "Fourth", "DDDD"

Debug.Print objSortedList.IndexOfKey("First")
Debug.Print objSortedList.IndexOfValue("AAAA")
Debug.Print objSortedList.IndexOfKey("Second")
Debug.Print objSortedList.IndexOfValue("BBBB")
Debug.Print objSortedList.IndexOfKey("Third")
Debug.Print objSortedList.IndexOfValue("CCCC")
Debug.Print objSortedList.IndexOfKey("Fourth")
Debug.Print objSortedList.IndexOfValue("DDDD")
 
For i = 0 To objSortedList.Count - 1
    Debug.Print objSortedList.GetKey(i) & vbTab & objSortedList.GetByIndex(i)
Next
 'Note how the list is automatically sorted by keys; it is not possible to sort the list by values.
 'Like ArrayLists, SortedLists have Count and Capacity properties, and a TrimToSize method, demonstrated in the following code:
 
Debug.Print "Size     : " & objSortedList.Count
Debug.Print "Capacity : " & objSortedList.Capacity
 
objSortedList.TrimToSize
 
Debug.Print "Size     : " & objSortedList.Count
Debug.Print "Capacity : " & objSortedList.Capacity
 'This will result in the following output:
 'Size     : 4
 'Capacity : 16
 'Size     : 4
 'Capacity : 4
 'Cloning a SortedList is a piece of cake:
Dim xxxx
Set objList2 = objSortedList.Clone
Debug.Print "Sorted List Key(1) = " & objSortedList.GetKey(1)
Debug.Print "Cloned List Key(1) = " & objList2.GetKey(1)
 'The result:
 'Sorted List Key(1) = Fourth
 'Cloned List Key(1) = Fourth
Set objList2 = Nothing
Set objSortedList = Nothing
End Sub
A+
 
Vote positif 0 Vote négatif
BOISGONTIER

BOISGONTIER

XLDnaute Barbatruc
Repose en paix
Re : Fonction de tri d'une variable tableau en VBA

L'objet Dictionary ne dispose pas de tri.

En PJ, un module de classe qui encapsule l'objet Dictionary en ajoutant un tri .

Une seule ligne suffit pour récupérer le résultat du tri dans le tableur ou dans un tableau.

Code: 
Sub ListeSansDoublonsDicoTrié()
  Set d1 = New Dictionnaire
  d1.init = 0
  a = Range("A2:b" & [A65000].End(xlUp).Row)
  For i = 1 To UBound(a)
    d1.ajout(a(i, 1)) = a(i, 2)
  Next i
  Set plg = Range("d2").Resize(d1.Count)
  plg.Value = d1.listeCles
  Set plg = Range("e2").Resize(d1.Count)
  plg.Value = d1.listeItems
  '--- tri
  Set plg = Range("d2").Resize(d1.Count, 2)
  plg.Value = d1.TriDict

Module de Classe Dictionnaire

Code: 
Private xn, Dict

Public Property Let init(n)
  Set Dict = CreateObject("Scripting.Dictionary")
  xn = n
End Property

Public Property Let ajout(cle, item)
  If Not Dict.Exists(cle) Then
    Dict(cle) = item
    xn = xn + 1
  End If
End Property

Public Property Get Count()
  Count = xn
End Property

Public Property Get listeItems()
  listeItems = Application.Transpose(Dict.Items)
End Property

Public Property Get listeCles()
  listeCles = Application.Transpose(Dict.keys)
End Property

Public Property Get item(cle)
  item = Dict(cle)
End Property

Public Property Get Existe(cle)
  Existe = Dict.Exists(cle)
End Property

Public Property Let Sup(cle)
  Dict.Remove (cle)
End Property

Public Property Get TriDict()
  Dim temp()
  ReDim temp(1 To Dict.Count, 1 To 2)
  i = 1
  For Each c In Dict.keys
    temp(i, 1) = c
    temp(i, 2) = Dict(c)
    i = i + 1
  Next c
  Call Tri(temp, LBound(temp), UBound(temp))
  TriDict = temp
End Property

Sub Tri(a, gauc, droi) ' Quick sort
  ref = a((gauc + droi) \ 2, 1)
  g = gauc: d = droi
  Do
    Do While a(g, 1) < ref: g = g + 1: Loop
    Do While ref < a(d, 1): d = d - 1: Loop
    If g <= d Then
      temp = a(g, 1): a(g, 1) = a(d, 1): a(d, 1) = temp
      temp = a(g, 2): a(g, 2) = a(d, 2): a(d, 2) = 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

JB
 

Pièces jointes

  • ClasseDictionnaireDico.xls
    100.5 KB · Affichages: 101
Dernière édition:
Vote positif 0 Vote négatif

Discussions similaires

J
  • Résolu(e)
XL 2016 fonction array
2
Réponses
16
Affichages
498
sylvanu
sylvanu
R
  • Résolu(e)
XL 2016 Somme par année en fonction d'une date de début et de fin
Réponses
4
Affichages
310
remyexcel
R
patricktoulon
  • Résolu(e)
XL 2013 prise de tête avec une variable static
Réponses
3
Affichages
237
patricktoulon
patricktoulon
G
  • Résolu(e)
XL 2016 Tri Tableau en fonction d'un bouton
Réponses
6
Affichages
222
Goose
G
B
  • Résolu(e)
Microsoft 365 affecter des valeurs dans un tableau de noms de variable
Réponses
4
Affichages
417
bérylion
B
L
  • Résolu(e)
Microsoft 365 VBA - Attribuer mise en forme en fonction de valeur cellule d'une liste
Réponses
14
Affichages
354
Laliepomm
L
O
  • Question
XL 2019 Je veux afficher mes données dans ma Listbox1 avec l'entete de ma Base donnée et fait la recherche sans que cela derange l'entete.
Réponses
6
Affichages
467
ChTi160
ChTi160
K
  • Question
Microsoft 365 Recherche valeur en fonction des 2 critères dans un tableau multi entrées
Réponses
3
Affichages
344
Khloe870
K
B
  • Résolu(e)
XL 2019 Tri onglets en fonction du contenu d'une cellule VBA
Réponses
9
Affichages
387
babie971
B
S
  • Question
Microsoft 365 VBA pour copier une une des données d'une ligne à une autre
Réponses
2
Affichages
179
crocrocro
C

Membres actuellement en ligne

12 membres et 216 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
312 339
Messages
2 087 400
Membres
103 537
dernier inscrit
alisafred974