Tri d'un tableau par la méthode "QuickSort"

Tri d'un tableau par la méthode "QuickSort"

Messagepar Michael DELIQUE » 23 Fév 2008 à 23:08

Code : Tout sélectionner
Sub SortQuick(vrTable As Variant)
   
   'Tri par "QuickSort" par ordre Croissant
   
   'Déclaration Variables
   Dim nbUBound As Long
   Dim nbLBound As Long
   Dim i As Long
   Dim J As Long
   Dim nbIndexMini As Long
   Dim vrValue As Variant   
   Dim vrBaliseMini As Variant
   
   On Error Goto ErreurHandle
   
   nbUBound = Ubound(vrTable)
   nbLBound = Lbound(vrTable)
   
   If nbUBound = nbLbound Then
       'si 1 seule donnée pas de traitement
      Exit Sub
   Elseif nbUBound = (nbLbound+1) Then
       'si uniquement 2 données
      If  vrTable(nbLbound) >  vrTable(nbUBound) Then
         vrValue = vrTable(nbUBound)
         vrTable(nbUBound) = vrTable(nbLbound)
         vrTable(nbLbound) = vrValue
         vrValue = Null
      End If
      Exit Sub
   End If
   
   For i=0 To nbUBound
      nbIndexMini = i
      vrBaliseMini = vrTable(nbIndexMini)
      For J = i +1 To nbUBound
         If vrTable(J) < vrBaliseMini Then
            nbIndexMini = J
            vrBaliseMini = vrTable(nbIndexMini)
         End If
      Next
      vrValue = vrTable(nbIndexMini)
      vrTable(nbIndexMini) = vrTable(i)
      vrTable(i) = vrValue
      vrValue = Null
   Next
   vrBaliseMini = Null
   
   Exit Sub
ErreurHandle:
   Msgbox "("+Cstr(Getthreadinfo (1))+" Call by "+Cstr(Getthreadinfo(10))+")"+Chr(10)+"Erreur " + Str(Err) + " : "+Chr(10) + Cstr(Error)+". "+Chr(10)+"Ligne N° "+Cstr(Erl),16," ERREUR !"
   Exit Sub
End Sub
Cordialement

Michael (SMS-Phobique)
----------------------------
"La théorie, c'est quand on sait tout et que rien ne fonctionne. La pratique, c'est quand tout fonctionne et que personne ne sait pourquoi."
Albert EINSTEIN
Avatar de l’utilisateur
Michael DELIQUE
Administrateur
Administrateur
 
Message(s) : 12183
Inscrit(e) le : 16 Déc 2004 à 10:36
Localisation : Paris/Cergy

Retour vers Fonctions de tris