トーナメント作成 ② とりあえず箱を配置する

昨日は参加人数から、トーナメントが何回戦まで行われるか求めてみた。
infoment.hatenablog.com

今日はこれを利用して、決勝戦までの箱を並べてみる。
f:id:Infoment:20191014214908p:plain

まず参加者だが、今回も「なんちゃって個人情報」のお世話になった。
f:id:Infoment:20191014215005p:plain

これを手作業でシート上に配置すると、このようになる。なお、この時点では昨日同様、シード選手については検討していない。
f:id:Infoment:20191014215237p:plain

箱の描画は、以下の条件で行った。

  1. 名前は一人あたり、二行一列とする。
  2. 上記セルは組合せ表記上、結合する。
  3. 一回戦と二回戦の間は二列とする(以降も同様)。
  4. 二回戦の人名は、一回戦の対戦者の中間に配置する(以降も同様)。
  5. 組み合わせは、セルの罫線で描画する。

f:id:Infoment:20191014215819p:plain

Sub sample()
    Cells.Clear

    ' トーナメント参加者リスト。
    ' ※シート1のなんちゃって個人情報を参照。
    ' ※この時点では、50人決め打ち。
    Dim arr() As Variant
        arr = Sheet1.Range("A2:A51").Value
    
    ' 参加者人数から、トーナメントが何回戦まで必要かを求める。
    Dim iMax As Long
        iMax = WorksheetFunction.RoundUp(WorksheetFunction.Log(UBound(arr), 2), 0)
    Dim i As Long
    Dim j As Long
    
        ' 1回戦~準決勝戦まで。
        For j = 1 To iMax
            ' j回戦の一人一人について
            For i = 1 To (2 ^ iMax) / (2 ^ (j - 1))
                With Cells((2 * i - 1) * 2 ^ (j - 1), 3 * j - 2).Resize(2)
                    .Merge
                    .Borders.Weight = xlThin
                End With
            Next
        Next

        ' 決勝戦。
        With Cells(2 ^ iMax, 3 * j - 2).Resize(2)
            .Merge
            .Borders.Weight = xlThin
        End With
End Sub

 

ここまで来ると、プログラミングというより最早、算数の領域なのかな。
コードだけだと分かり難いので、手書きで恐縮だが数式でもご紹介。
f:id:Infoment:20191014221928p:plain

結果、箱までは描画することが出来た。
f:id:Infoment:20191014222130p:plain

この箱を、どうすればシンプルに繋げられるかが次の課題。
明日の晩まで、頭を捻るとしよう。

明日に続きます。

参考まで。