トーナメント作成 ③ 箱を罫線で繋ぐ

昨日は参加人数に合わせて、一回戦から優勝までの人名記入用セルを配置した。
infoment.hatenablog.com

今日は、この箱を罫線で縦横つなぐことに挑戦する。

さて、まず横の線だが、これは名前のセルを結合する前に引いておくことにした。

次いで、昨日のコードに「縦線」描画のループを追加する。

Sub Sample()

    Cells.Clear
    
    ' トーナメント参加者リスト。
    ' ※シート１のなんちゃって個人情報を参照。
    ' ※この時点では、50人決め打ち。
    Dim arr() As Variant
        arr = Sheet1.Range("B2:B51").Value
    
    ' 参加者人数から、トーナメントが何回戦まで必要かを求める。
    Dim iMax As Long
        iMax = WorksheetFunction.RoundUp(WorksheetFunction.Log(UBound(arr), 2), 0)
    Dim i As Long
    Dim j As Long
    
        ' １回戦～準決勝戦まで。
        For j = 1 To iMax
            ' ｊ回戦の一人一人について。
            For i = 1 To (2 ^ iMax) / (2 ^ (j - 1))
                With Cells((2 * i - 1) * 2 ^ (j - 1), 3 * j - 2)
                    Select Case j
                        ' 横の罫線だけ、先に描画しておく。
                        ' ※セル結合により、人名入力セル内は罫線が無くなる。
                        Case 1
                            .Resize(, 2).Borders(xlEdgeBottom).Weight = xlThin
                        Case Else
                            .Resize(, 3).Offset(, -1).Borders(xlEdgeBottom).Weight = xlThin
                    End Select
                    .Resize(2).Merge
                    .Resize(2).Borders.Weight = xlThin
                End With
            Next
        Next
    
        ' 決勝戦。
        With Cells(2 ^ iMax, 3 * j - 2)
            .Resize(, 2).Offset(, -1).Borders(xlEdgeBottom).Weight = xlThin
            .Resize(2).Merge
            .Resize(2).Borders.Weight = xlThin
        End With
        
        ' 縦の線。
        For j = 1 To iMax
            For i = 1 To 2 ^ (iMax - j)
                Cells((2 ^ (j + 1)) * i - (3 * 2 ^ (j - 1) - 1), 3 * j - 1).Resize(2 ^ j).Borders(xlEdgeRight).Weight = xlThin
            Next
        Next

End Sub

結果、ここまで自動描画することが出来た。

縦線のループを作成する過程で、随分と久しぶりに「階差数列」の式を求めた。
今回も、プログラミングというより数学の要素が強いかも。

ここまでは、前哨戦。ここからが、もっとややこしくなる予定なのだが。
まだ、考えをまとめ切れていない。さて、どうなることやら。

明日に続きます。

参考まで。