Page 1 sur 1

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

MessagePublié: 23 Fév 2008 à 23:08
par Michael DELIQUE
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