再びトーナメント表作成 ③ 順番をランダムに並べ替えたい-2

昨日は、トーナメントに於いて対戦カードをランダムにするために、
配列の順番をランダムに並べ替えることに挑戦した。
infoment.hatenablog.com
書き始めた時刻が遅かったこともあり、残念ながらタイムアウトとなった。
今日は、昨日の続きから。

理屈の部分は、昨日の内に終えている。
ここで要件として、

n番目以降からランダムソートしたい

を追加してみよう。目的は、例えば

前回入賞者(1~4位)はトーナメント内の位置を固定し、5位以降の選手はランダムに配置したい

などの要求に対応するためだ。

以上を踏まえて作成したのがこちら。なお、配列ソートの関数については、
以前作成したものを流用している。

Function GetRandomSortArray(total As Long, Optional start_number As Long = 1) As Variant

    ' 作業用配列。
    Dim TempArray As Variant
    ReDim TempArray(1 To total)
    ' 戻り値用配列。
    Dim arr As Variant
    ReDim arr(1 To total)

    Dim i As Long
        For i = 1 To total
            ' ソートしない範囲。
            If i < start_number Then
                TempArray(i) = i
            
            ' ソート範囲。iMax以上の桁でソートする。
            ' このときtotalの桁数範囲には、元の数字が保存されている。
            Else
                TempArray(i) = CLng(WorksheetFunction.RandBetween(1, 100) * _
                              (10 ^ Len(CStr(total))) + i)
            End If
        Next

        ' 配列ソート。
        TempArray = SortArray(TempArray)
        
        ' 保存された元の数字を取り出す。
        ' SortArray関数を使用すると、配列が0始まりになるので注意。
        For i = total To 1 Step -1
            arr(i) = Right(TempArray(i - 1), CLng(Len(CStr(total)))) * 1
        Next
        
        GetRandomSortArray = arr

End Function
Public Function SortArray(ByVal source_array As Variant, _
                       Optional sort_order As Excel.XlSortOrder = xlAscending) As Variant
                       
    Dim aryList As Object
    Set aryList = CreateObject("System.Collections.ArrayList")
    Dim s As Variant
    
        For Each s In source_array
            Call aryList.Add(s)
        Next
    
        Select Case sort_order
            Case xlAscending
                ' 昇順でソート。
                Call aryList.Sort
            Case xlDescending
                ' 昇順でソートののち、降順へ反転。
                Call aryList.Sort
                Call aryList.Reverse
        End Select
    
        SortArray = aryList.ToArray
        
End Function

それでは、テストしてみよう。1~32の数字について、5番目以降から
ランダムソートしてみる。

Sub Test()

    Dim arr As Variant
        arr = GetRandomSortArray(32, 5)
        
        Range("A1:A32") = WorksheetFunction.Transpose(arr)

End Sub

結果がこちら。意図したとおり、1~4は順番通りで、5番目からランダムに
並び替えられている。

これはこれで、ちょっとややこしかったかな。

次回に続きます。

参考まで。