Page 1 sur 1
Tri d'un tableau par la methode "par Tas"
Publié:
26 Fév 2008 à 08:55par Michael DELIQUE
- Code : Tout sélectionner
Sub SortHeap(vrTable As Variant)
'Tri par "Tas/Heap" par ordre croissant
'Déclaration Variables
Dim nbUBound As Long
Dim nbLBound As Long
Dim nbHigh As Long
Dim i As Long
Dim j As Long
Dim k As Long
Dim vrValue As Variant
On Error Goto ErreurHandle
nbLbound = Lbound(vrTable)
nbUBound = Ubound(vrTable)
If nbUBound = nbLbound Then
'si 1 seul donné 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
nbHigh = nbUBound
For i = nbUBound \ 2 To nbLBound Step -1
k = i
vrValue = vrTable( k )
Do While k <= nbUBound \ 2
j = k + k
If j < nbUBound Then
If vrTable( j ) < vrTable( j + 1 ) Then
j = j + 1
End If
End If
If vrValue >= vrTable( j ) Then
Exit Do
End If
vrTable( k ) = vrTable( j )
k = j
Loop
vrTable( k ) = vrValue
Next
Do
vrValue = vrTable(nbLBound)
vrTable(nbLBound) = vrTable(nbHigh)
vrTable(nbHigh) = vrValue
vrValue = Null
nbHigh = nbHigh - 1
k = nbLBound
vrValue = vrTable( k )
Do While k <= nbHigh \ 2
j = k + k
If j < nbHigh Then
If vrTable( j ) < vrTable( j + 1 ) Then
j = j + 1
End If
End If
If vrValue >= vrTable( j ) Then
Exit Do
End If
vrTable( k ) = vrTable( j )
k = j
Loop
vrTable( k ) = vrValue
Loop Until nbHigh = nbLBound
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