Option Explicit

Sub main()
'ＷｏｒｄＶＢＡでマージソート実装例


On Error GoTo E
Dim c1 As New Collection
Dim c2 As New Collection
Dim o
c1.Add "ken", "1"
c1.Add "joe", "2"
c1.Add "acep", "3"
c1.Add "bob", "11"
c1.Add "zen", "5"
c1.Add "asu", "6"

Set c2 = msort(c1)
For Each o In c2
    Debug.Print o
Next
MsgBox "ok"
E:
Set c1 = Nothing
Set c2 = Nothing
End Sub

Function msort(c As Collection) As Collection
Dim cL1 As New Collection
Dim cL2 As New Collection
Dim cr1 As New Collection
Dim cr2 As New Collection
Dim resC As New Collection
Dim m As Long
Dim m2 As Long
Dim i
Dim lp, rp, p
Dim lmax, rmax

m = c.Count
If m = 0 Then
    '何もしない
ElseIf m = 1 Then
    resC.Add c(1)
Else
    m = m - 1
    m2 = m \ 2
    p = 1
    For i = 0 To m2
        cL1.Add c(i + 1)
    Next
    p = 1
    For i = m2 + 1 To m
        cr1.Add c(i + 1)
    Next
    Set cL2 = msort(cL1)
    Set cr2 = msort(cr1)
    lmax = cL2.Count
    rmax = cr2.Count
    lp = 1
    rp = 1
    While lp <= lmax Or rp <= rmax
        If lp > lmax Then
            resC.Add cr2(rp)
            rp = rp + 1
        ElseIf rp > rmax Then
            resC.Add cL2(lp)
            lp = lp + 1
        Else
            If cL2(lp) > cr2(rp) Then
                resC.Add cr2(rp)
                rp = rp + 1
            Else
                resC.Add cL2(lp)
                lp = lp + 1
            End If
        End If
        p = p + 1
    Wend
End If

Set cL1 = Nothing
Set cL2 = Nothing
Set cr1 = Nothing
Set cr2 = Nothing
Set msort = resC

End Function