Tri d'un tableau par la methode "Introspective"

[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