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

Publié:
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