【VBA】マージソートを活用した配列内の並び替え2（文字列ver.）コピペOK

Function merge_Sort_for_strComp(arrs As Variant, asc As Boolean)
    '配列を二分割する。左(Larrs)と右(Rarrs)で便宜上命名
    Dim Larrs(), Rarrs() As Variant
    Dim m As Long '配列の真ん中を整数で取得
    Dim i As Long '二分割した後の配列(Larrs,Rarrs)に格納するためのインデックス
    Dim Li As Long 'Larrsに格納する値をarrsで指定するためのインデックス
    Dim Ri As Long 'Rarrsに格納する値をarrsで指定するためのインデックス
    
    If UBound(arrs) <= 0 Then
        '分割前の配列が最大要素が0以下(=要素数1以下)になったら終了
        '再帰関数の出口＝これがないと多分エラーで止まる(か、無限ループ？）
        merge_Sort_for_strComp = arrs
    Else
        '要素数を2で割った商を1引く
        m = (UBound(arrs) + 1) \ 2 - 1
        
        '元の配列(arrs)の要素から、0～m(要素数の真ん中)までの要素をLarrsに格納
        i = 0
        For Li = 0 To m
            ReDim Preserve Larrs(i)
            Larrs(i) = arrs(Li)
            i = i + 1
        Next Li
        
        '元の配列(arrs)の要素から、m+1～最後までの要素をRarrsに格納
        i = 0
        For Ri = m + 1 To UBound(arrs)
            ReDim Preserve Rarrs(i)
            Rarrs(i) = arrs(Ri)
            i = i + 1
        Next Ri
        
        '再帰処理
        Larrs = merge_Sort_for_strComp(Larrs, asc)
        Rarrs = merge_Sort_for_strComp(Rarrs, asc)
        merge_Sort_for_strComp = merge_for_strComp(Larrs, Rarrs, asc)
    End If
End Function

Function merge_for_strComp(Larrs As Variant, Rarrs As Variant, asc As Variant)
    Dim Li As Long '左側の配列(Larrs)のインデックス
    Dim Ri As Long '右側の配列(Rarrs)のインデックス
    Dim Ai As Long '結合後の配列のインデックス
    Dim arrs() As Variant '結合後の配列
    Dim str As String '結合後の配列に格納する要素を入れる
    Dim i As Long '残っている要素を一気に格納するためのインデックス

    '結合するために二つの配列を用意する。
    '便宜上、左側の配列（以下Larrs)と右側の配列(以下Rarrs)と命名する。
    'LarrsとRarrsの要素を比較し、小さいものを結合後の配列(以下arrs)に格納する
    
    'LarrsとRarrsの要素どちらも残っている場合、
    '要素を比較して小さい方をarrsに格納する。
    '入れた方の配列はインデックスを＋1する。
    
    If asc = True Then
        Do While (Li <= UBound(Larrs)) And (Ri <= UBound(Rarrs))
            If StrComp(Larrs(Li), Rarrs(Ri)) >= 0 Then
                str = Rarrs(Ri)
                Ri = Ri + 1
            Else
                str = Larrs(Li)
                Li = Li + 1
            End If
    
            ReDim Preserve arrs(Ai)
            arrs(Ai) = str
            Ai = Ai + 1
        Loop
    Else
        Do While (Li <= UBound(Larrs)) And (Ri <= UBound(Rarrs))
            If StrComp(Larrs(Li), Rarrs(Ri)) <= 0 Then
                str = Rarrs(Ri)
                Ri = Ri + 1
            Else
                str = Larrs(Li)
                Li = Li + 1
            End If
    
            ReDim Preserve arrs(Ai)
            arrs(Ai) = str
            Ai = Ai + 1
        Loop
    End If

    'Larrsに要素が残っていたら、処理
    If Li <> UBound(Larrs) + 1 Then
        For i = Li To UBound(Larrs)
            ReDim Preserve arrs(Ai)
            arrs(Ai) = Larrs(i)
            Ai = Ai + 1
        Next i
    End If

    'Rarrsに要素が残っていたら、処理
    If Ri <> UBound(Rarrs) + 1 Then
        For i = Ri To UBound(Rarrs)
            ReDim Preserve arrs(Ai)
            arrs(Ai) = Rarrs(i)
            Ai = Ai + 1
        Next i
    End If

    merge_for_strComp = arrs
End Function

Sub test()
    Dim arrs As Variant 'ソート前の配列
    Dim results As Variant 'ソートをした後の配列
    
    arrs = Array("a", "e", "d", "c", "b")
    results = merge_Sort_for_strComp(arrs, True)
    Stop
End Sub

Sub test2()
    Dim arrs As Variant 'ソート前の配列
    Dim results As Variant 'ソートをした後の配列
    
    arrs = Array("Ａ", "ｱｲ", "a", "aa", "aBC", "abc", "あ", "あい", "A", "ABC", "愛", "相", "アイ", "あお")
    results = merge_Sort_for_strComp(arrs, True)
    Stop
End Sub