'Merge sorting
Option explicit
Dim result, I
Dim testdata (100)
Const n= 100
Randomize
For I = 0 to n-1
Testdata (I) = round (RND () * 32768)
Next
Sub mergeto (byref array, byref DEST, low, mid, hi)
Dim I, J, K, d
I = low
J = mid
D = low
Do
If I = mid or J = Hi + 1 then
Exit do
End if
If array (I) <array (j) then
DeST (d) = array (I)
I = I + 1
Else
DeST (d) = array (j)
J = J + 1
End if
D = d + 1
Loop
For k = I to mid-1
DeST (d) = array (k)
D = d + 1
Next
For k = J to hi
DeST (d) = array (k)
D = d + 1
Next
End sub
Sub Merge (byref array, byref temp, low, hi, length)
Dim I, j
For I = low to hi-length step length * 2
J = I + 2 * length-1
If j> Hi then
J = Hi
End if
Mergeto array, temp, I, I + length, J
Next
For J = I to hi
Temp (j) = array (j)
Next
End sub
'Merge sorting, non-recursion
Sub mergesort (byref array, low, hi)
Dim temp (100), I, Length
Length = Hi-low + 1
I = 1
Do
Merge array, temp, low, hi, I
I = I * 2
Merge temp, array, low, hi, I
I = I * 2
If I> length then
Exit do
End if
Loop
End sub
'Merge sorting, recursion
Sub mergesort1 (byref array, low, hi)
Dim temp (100), I, mid
If low> = Hi then
Exit sub
End if
Mid = int (low + hi)/2)
Mergesort1 array, low, mid
Mergesort1 array, Mid + 1, hi
Mergeto array, temp, low, Mid + 1, hi
For I = low to hi
Array (I) = temp (I)
Next
End sub
Mergesort testdata, 0, n-1
For I = 0 to n-1
Result = Result & testdata (I) & vbtab
Next
Msgbox (result)