再びトーナメント表作成 ③ 順番をランダムに並べ替えたい-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番目からランダムに
並び替えられている。
これはこれで、ちょっとややこしかったかな。
次回に続きます。
参考まで。