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

[Michael DELIQUE]

Code : Tout sélectionner

Sub SortTrap(tbValue() As Long)
   
   'Tri par "Casier/Trap" par ordre croissant
   
   'Déclaration Variables
   Dim nbUBound As Long
   Dim nbLBound As Long
   Dim nbIndexMini As Long
   Dim nbIndexMaxi As Long
   Dim nbUBoundTemp As Long
   Dim tbValueTemp() As Long
   Dim J As Long
   Dim i As Long
   
   nbUBound = Ubound(tbValue)   
   nbLBound = Lbound(tbValue)
   
   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  tbValue(nbLbound) >  tbValue(nbUBound) Then
         J = tbValue(nbUBound)
         tbValue(nbUBound) = tbValue(nbLbound)
         tbValue(nbLbound) = J
      End If
      Exit Sub
   End If
   
   nbIndexMini = tbValue(nbLBound)
   nbIndexMaxi = nbIndexMini
   
   For i = nbLBound To nbUBound
      If nbIndexMini > tbValue(i) Then
         nbIndexMini = tbValue(i)
      End If
      If nbIndexMaxi < tbValue(i) Then
         nbIndexMaxi = tbValue(i)
      End If
   Next   
   
   nbUBoundTemp = nbIndexMaxi - nbIndexMini+1
   
   Redim tbValueTemp(nbLbound To nbUBoundTemp)
   
   For i = nbLBound To nbUBoundTemp
      tbValueTemp(i) = 0   
   Next
   
   For i = nbLBound To nbUBound
      j = tbValue(i)-nbIndexMini
      tbValueTemp(J) = tbValueTemp(J)+1
   Next
   
   J = 0
   For i = nbLBound To nbUBoundTemp
      While tbValueTemp(i)>0
         tbValue(J) = nbIndexMini+i
         tbValueTemp(i) = tbValueTemp(i)-1
         J = J+1
      Wend
   Next
   
   Erase tbValueTemp
   
   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