Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

problème tr rapide QuickSort dans une listbox1

crisud

XLDnaute Nouveau
Bonjour,


J'affiche une liste dans une listbox1, composé de 2 champs [no] et [Libellé]
J'arrive à trier avec un tri à bulle, mais c'est trop long.


J'ai trouvé un code de tri rapide, mais cela ne marche pas, j'ai une erreur

Alors je fais appel à vous, pour aboutir à mon tri


Je joins le fichier test

Merci d'avance
Christian
 

Pièces jointes

  • V1.zip
    171.8 KB · Affichages: 27
  • V1.zip
    171.8 KB · Affichages: 25
  • V1.zip
    171.8 KB · Affichages: 26
Dernière édition:

BOISGONTIER

XLDnaute Barbatruc
Repose en paix
Re : problème tr rapide QuickSort dans une listbox1

Bonjour,

Code:
Private Sub UserForm_Activate()
Dim Tb, Ii, Ij
'Dim TabListBox As Variant
Dim lib() As String
Dim i, j, k, l As Byte
Dim temp As String
Set f = Sheets("t_client")
a = f.Range("a2:c" & f.[A65000].End(xlUp).Row)
Dim b(), c()
j = 0
Me.ListBox1.ColumnCount = 2
Me.ListBox1.ColumnWidths = "45;100"
        For i = LBound(a) To UBound(a)
            If a(i, 1) = "Oui" Then
                j = j + 1
                ReDim Preserve b(1 To 2, 1 To j)
                b(1, j) = a(i, 2)
                b(2, j) = a(i, 3)
            End If
        Next i
        c = Application.Transpose(b)
        Call Tri(c(), 1, LBound(c, 1), UBound(c, 1))
        Me.ListBox1.list = c
End Sub

Sub Tri(a(), ColTri, gauc, droi) ' Quick sort
  ref = a((gauc + droi) \ 2, ColTri)
  g = gauc: d = droi
  Do
    Do While a(g, ColTri) < ref: g = g + 1: Loop
    Do While ref < a(d, ColTri): d = d - 1: Loop
    If g <= d Then
       For k = LBound(a, 2) To UBound(a, 2)
         temp = a(g, k): a(g, k) = a(d, k): a(d, k) = temp
       Next k
       g = g + 1: d = d - 1
    End If
  Loop While g <= d
  If g < droi Then Call Tri(a, ColTri, g, droi)
  If gauc < d Then Call Tri(a, ColTri, gauc, d)
End Sub

Code:
Private Sub CommandTriNom_Click()
  Dim a()
  a = Me.ListBox1.list
  Call Tri(a(), 1, LBound(a, 1), UBound(a, 1))
  Me.ListBox1.list = a
End Sub

JB
 

Pièces jointes

  • Copie de V1.xls
    661.5 KB · Affichages: 83
Dernière édition:

crisud

XLDnaute Nouveau
Re : problème tr rapide QuickSort dans une listbox1

bonjour,
merci de l'intérêt porté à mon code.
Ta solution fonctionne parfaitement

Merci encore bon dimanche

Cela peut intéresser d'autre.....
Il faut rajouter des déclarations dans le fichier
Code:
Private Sub UserForm_Activate()
Dim a
Dim temp As String
Dim f As Worksheet
.
.
.

 'Le chargement du tri initial est à remplacer la zone libellé est en (2)
Call Tri(c(), 1, LBound(c, 2), UBound(c, 2))

Code:
Sub Tri(a(), ColTri, gauc, droi) ' Quick sort
  Dim ref As String
  Dim g As Long
  Dim d As Long
  Dim k As Byte
  Dim temp As String
 
Dernière édition:

Discussions similaires

Réponses
19
Affichages
2 K
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…