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

[Michael DELIQUE]

Sub SortMerge(vrArray As Variant, nbLbound As Long, nbUBound As Long)

'Tri par Merge (récurssif) par ordre croissant

Dim vrValue As Variant
Dim nbLow As Long
Dim nbLowEnd As Long
Dim nbHigh As Long
Dim nbHightStart As Long
Dim nbMid As Long
Dim i As Long

On Error Goto ErreurHandle

Select Case Datatype(vrArray)
Case 0,1,9,10 ' EMPTY,NULL,OLE object or NOTHING
'error 9999,"vrArray is Nothing"
Exit Sub
Case Else
If Isarray(vrArray)= False Then
Error 9999,"vrArray is not a Array"
Exit Sub
End If
End Select

'si les deux bound sont a zero = premiere itération donc renseignement
If nbLBound = 0 And nbUBound = 0 Then
nbLBound = Lbound(vrArray)
nbUBound = Ubound(vrArray)
End If

nbLow = nbLbound
nbHigh = nbUBound
If nbLow >= nbHigh Then
Exit Sub
End If

nbMid = (nbLow + nbHigh) \ 2

Call SortMerge(vrArray, nbLow, nbMid)
Call SortMerge(vrArray, nbMid + 1, nbHigh)

nbLowEnd = nbMid
nbHightStart = nbMid + 1

While nbLow <= nbLowEnd And nbHightStart <= nbHigh
If vrArray(nbLow) < vrArray(nbHightStart) Then
nbLow = nbLow + 1
Else
vrValue = vrArray(nbHightStart)
For i = nbHightStart -1 To nbLow Step -1
vrArray(i + 1) = vrArray(i)
Next
vrArray(nbLow) = vrValue
vrValue = Null
nbLow = nbLow + 1
nbLowEnd = nbLowEnd + 1
nbHightStart = nbHightStart + 1
End If
Wend

Exit Sub
ErreurHandle:
Msgbox "("+Structure_Log+" : "+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 !"
Set Session = New NotesSession
Call Error_LOG(Session.CurrentDatabase,Cstr(Session.Username),Cstr(Now),Structure_Log,Cstr(Getthreadinfo(1)),Cstr(Err),Cstr(Error),Cstr(Erl),Cstr(Getthreadinfo(10)))
Exit Sub
End Sub