Page 1 sur 1
Tri d'un tableau par la methode "Introspective"

Publié:
24 Fév 2008 à 14:56
par Michael DELIQUE
- Code : Tout sélectionner
Sub SortIntrospective( vrTable As Variant, nbLBound As Long, nbUBound As Long)
'Tri par "QuickSort Recursif ou Introspection" récursif par ordre Croissant
'Déclaration Variables
Dim nbLow As Long
Dim nbHigh As Long
Dim vrPivot As Variant
Dim vrValue As Variant
On Error Goto ErreurHandle
'si les deux bound sont a zero = premiere itération donc renseignement
If nbLBound = 0 Then
If nbUBound = 0 Then
nbLBound = Lbound(vrTable)
nbUBound = Ubound(vrTable)
End If
End If
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
nbLow = nbLBound
nbHigh = nbUBound
If ( nbUBound > nbLBound) Then
vrPivot = vrTable( (nbLBound + nbUBound) /2)
While ( nbLow <= nbHigh )
While (nbLow < nbUBound) And (vrTable(nbLow) < vrPivot )
nbLow = nbLow+1
Wend
While ( nbHigh > nbLBound ) And ( vrTable(nbHigh) > vrPivot )
nbHigh = nbHigh - 1
Wend
vrPivot = Null
If ( nbLow <= nbHigh ) Then
vrValue = vrTable(nbLow)
vrTable(nbLow) = vrTable(nbHigh)
vrTable(nbHigh) =vrValue
vrValue = Null
nbLow = nbLow+1
nbHigh = nbHigh -1
End If
Wend
If( nbLBound < nbHigh ) Then
Call SortIntrospective( vrTable, nbLBound, nbHigh )
End If
If( nbLow < nbUBound ) Then
Call SortIntrospective( vrTable, nbLow, nbUBound )
End If
End If
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