Page 1 sur 1
Tri d'un tableau par la méthode "par Casier"
Publié:
23 Fév 2008 à 23:43par 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