エクセルでトーナメント表を自動作成するマクロ【ダウンロード可】

2019-06-02

以前VBAをかじった際に作成したトーナメント表を自動で作成するエクセルマクロを公開しようと思い、この記事を書きました。

ダウンロードはこちらからどうぞ↓
トーナメント表作成マクロver1.4

作成にあたって参考にした書籍はこちらです。
どれもおすすめなので、ぜひこれからVBAの勉強を始められる方は使ってみてください。

入門者のExcel VBA―初めての人にベストな学び方 (ブルーバックス)
これは一番始めに読んだ書籍でした。
本当に初歩的な内容について書かれていて、関数すら使ったことがなかった僕でもスラスラ読めました。

この一冊だけでも、非エンジニア職のオフィスでなら一目置かれるレベルのスキルが身につきます(実体験)

Excel VBA 本格入門 ~日常業務の自動化からアプリケーション開発まで~

できる逆引き Excel VBAを極める勝ちワザ700 2016/2013/2010/2007対応

こちらはもう少し高度な内容に触れてます。
特に逆引きの方はかなり分厚いのですが、その代わりにかゆいところに手が届く内容になっており、辞書代わりに使ってます。

また、ExcelやVBAのスキルについては、Udemyという動画学習サイトもおすすめです。
質の高い講座が多く、僕もいつも利用しています。

追記(2019年5月1日)

上記のエクセルファイルのダウンロードリンクがしばらく切れてしまっており、大変ご迷惑をおかけしました。
本日リンクの修正と、高速化処理を追加したver1.3を公開いたしました。

今後はこのようなことが無いよう善処いたしますが、もし万が一ダウンロードできないなどのトラブルがありましたら、コメントかTwitterにてご連絡いただけますと幸いです。

よろしくお願いいたします。

使い方

使い方はいたって簡単です。
まずはこの入力フォームに、大会名と参加人数を入力してください。

入力が完了したら、あとは隣の作成ボタンをクリック!

するとあっという間に別シートで下の画像のようなトーナメント表が作成されます。

あとはこちらに選手の名前を入力するなりコピペするなり、ご自由にお使いください。

注意点

残念ながら、8人以下と129人以上のトーナメントには対応しておりません。
8人以下の場合は、別シートのテンプレートをご利用ください。

ソースコード公開

初めて作ったVBAプログラムですので、非常に拙いコードですが公開します。
ぜひご指導等ありましたらコメントお願いします。

この当時は慣れないVBAな上に、トーナメント表作成のアルゴリズムがわからず、かなり苦労した記憶があります。

無駄の多いコードですので、閲覧注意でお願いしますね。
あとめちゃめちゃ長いです笑

追記(2018/11/05)

以下のコードのままマクロを実行すると、『応答なし』という表記になることがあります。
こちらは、エクセルで自動描画設定がONになっているため、処理が追いつかないことが原因のようです。
このコードはプログラミングを初めてすぐのころに書いたので、気が向いたらそのうち力試しにコードを書き直そうと思います。

  Sub macro()
    Dim i As Integer
    Dim cnt As Integer 'カウント'
    Dim player_sum 'プレイヤー人数'
    Dim player_sum_right 'プレイヤー人数''
    Dim player_sum_left 'プレイヤー人数''
    Dim kyougi '競技名'
    'sheet1から選手名と人数とシード有無と競技名を取得'
    kyougi = Range("B12")
    player_sum = Range("F12").Value '選手人数を入力させ、真偽判定。カウントした人数と違えばエラーにする'
    '選手名、番号、シード有無を変数に保存'
    cnt_left = player_sum_left - 1
    cnt_right = player_sum_right - 1
    Dim match '試合数'
    match = player_sum
 If player_sum <= 8 Or player_sum > 128 Then
    MsgBox "エラー。人数を再度入力してやり直してください。"
 Else
    'sheet2を新たに作成し、枠をつくる'
    Sheets.Add(After:=ActiveSheet).Name = kyougi  '以降新たなシートがアクティブシート'
    'シートのセルの幅と高さを変更し、一部を結合'
    Columns("A:C").ColumnWidth = 32
    Columns("B:B").ColumnWidth = 3.5
    Rows("1:200").RowHeight = 18
    For i = 1 To 200
        Range(Cells(i + 4, 1), Cells(i + 5, 1)).Merge
        Range(Cells(i + 4, 3), Cells(i + 5, 3)).Merge
        i = i + 1
    Next
   '競技名を作成'
    Range("A1:C3").Select
    Selection.Merge
    Range("A1").Value = kyougi & "  " & player_sum & "人"
    Range("A1").HorizontalAlignment = xlCenter
    Range("A1").VerticalAlignment = xlCenter
    Range("A1").Font.Size = 20
    Selection.Font.Underline = xlUnderlineStyleSingle
    '選手人数に応じて列を追加'
'<16'
    If player_sum <= 16 And player_sum > 8 Then
        For i = 1 To 7
            Columns(3).Insert
        Next
    '決勝ボックスの作成'
        r = Application.RoundDown(player_sum / 2, 0)
        rll = Application.RoundDown(r / 2, 0)
        rl = rll * 2
        Range(Cells(rl + 3, 5), Cells(rl + 3, 6)).Merge
        With Cells(rl + 3, 5)
            .Value = "決勝"
            .Font.Size = 9
            .HorizontalAlignment = xlCenter
            .VerticalAlignment = xlCenter
        End With
        Cells(rl + 4, 5).Borders(xlEdgeRight).LineStyle = xlContinuous
        Cells(rl + 5, 5).Borders(xlEdgeTop).LineStyle = xlContinuous
        Cells(rl + 5, 6).Borders(xlEdgeTop).LineStyle = xlContinuous
        Range(Cells(rl + 4, 4), Cells(rl + 5, 4)).Merge
        With Cells(rl + 4, 4)
            .Value = player_sum - 3
            .Font.Size = 8
        End With
        Range(Cells(rl + 4, 7), Cells(rl + 5, 7)).Merge
        With Cells(rl + 4, 7)
            .Value = player_sum - 2
            .Font.Size = 8
            .HorizontalAlignment = xlLeft
        End With
        Range(Cells(rl + 5, 5), Cells(rl + 5, 6)).Merge
        With Cells(rl + 5, 5)
            .Value = player_sum
            .Font.Size = 8
            .HorizontalAlignment = xlCenter
            .VerticalAlignment = xlCenter
        End With
    '三決ボックスの作成'
        Range(Cells(player_sum + 4, 5), Cells(player_sum + 4, 6)).Merge
        With Cells(player_sum + 4, 5)
            .Value = "三決"
            .Font.Size = 9
            .HorizontalAlignment = xlCenter
            .VerticalAlignment = xlCenter
        End With
        Cells(player_sum + 5, 5).Borders(xlEdgeRight).LineStyle = xlContinuous
        With Cells(player_sum + 6, 5)
            .Borders(xlEdgeTop).LineStyle = xlContinuous
            .Borders(xlEdgeLeft).LineStyle = xlContinuous
        End With
        With Cells(player_sum + 6, 6)
            .Borders(xlEdgeTop).LineStyle = xlContinuous
            .Borders(xlEdgeRight).LineStyle = xlContinuous
        End With
        Range(Cells(player_sum + 6, 6), Cells(player_sum + 6, 5)).Merge
        With Cells(player_sum + 6, 5)
            .Value = player_sum - 1
            .Font.Size = 8
            .HorizontalAlignment = xlCenter
            .VerticalAlignment = xlCenter
        End With
    '完全二分木をつくる、左上、右上は普通、左下、右下は反転二分木'
    '1層'
        player_left_first = Application.RoundDown(player_sum / 2, 0)
        player_right_first = Application.RoundUp(player_sum / 2, 0)
    '左二分木 17から32までなら最下層は5層'
       '2層'
        '左'
        Dim player_left_second0() As Integer
        ReDim player_left_second0(1)
        player_left_second0(0) = Application.RoundDown(player_left_first / 2, 0)
        player_left_second0(1) = Application.RoundUp(player_left_first / 2, 0)
        '右'
        Dim player_right_second0() As Integer
        ReDim player_right_second0(1)
        player_right_second0(0) = Application.RoundDown(player_right_first / 2, 0)
        player_right_second0(1) = Application.RoundUp(player_right_first / 2, 0)
        '3層'
        '左'
        Dim player_left_third0() As Integer
        ReDim player_left_third0(3)
        player_left_third0(0) = Application.RoundDown(player_left_second0(0) / 2, 0)
        player_left_third0(1) = Application.RoundUp(player_left_second0(0) / 2, 0)
        player_left_third0(2) = Application.RoundDown(player_left_second0(1) / 2, 0)
        player_left_third0(3) = Application.RoundUp(player_left_second0(1) / 2, 0)
        nonseed = 0
        For i = 0 To 3
           If player_left_third0(i) = 2 Then
               nonseed = nonseed + 1
           End If
        Next
        '右'
        Dim player_right_third0() As Integer
        ReDim player_right_third0(3)
        player_right_third0(0) = Application.RoundDown(player_right_second0(0) / 2, 0)
        player_right_third0(1) = Application.RoundUp(player_right_second0(0) / 2, 0)
        player_right_third0(2) = Application.RoundUp(player_right_second0(1) / 2, 0)
        player_right_third0(3) = Application.RoundDown(player_right_second0(1) / 2, 0)
        r_nonseed = 0
        For i = 0 To 3
           If player_right_third0(i) = 2 Then
               r_nonseed = r_nonseed + 1
           End If
        Next
        '4層'
        '左'
        Dim player_left_fourth0() As Integer
        ReDim player_left_fourth0(3 + nonseed)
        n = 0
        For i = 0 To 3
            If player_left_third0(i) = 1 Then
                player_left_fourth0(n) = 0
                n = n + 1
            Else
                player_left_fourth0(n) = 1
                player_left_fourth0(n + 1) = 1
                n = n + 2
            End If
        Next
        '右'
        Dim player_right_fourth0() As Integer
        ReDim player_right_fourth0(3 + r_nonseed)
        n = 0
        For i = 0 To 3
            If player_right_third0(i) = 1 Then
                player_right_fourth0(n) = 0
                n = n + 1
            Else
                player_right_fourth0(n) = 1
                player_right_fourth0(n + 1) = 1
                n = n + 2
            End If
        Next
        '二分木をもとにトーナメント表を作成'
        '左'
        '1,2段目'
        match = 1
        n = 0
        m = 0
        For i = 0 To player_left_first * 2 - 1
            If i Mod 2 = 0 Then
                Cells(i + 5, 2).Borders(xlEdgeBottom).LineStyle = xlContinuous
                n = i / 2
                If player_left_fourth0(n) = 0 Then
                    Cells(i + 5, 3).Borders(xlEdgeBottom).LineStyle = xlContinuous
                Else
                    If m Mod 2 = 0 Then
                        Cells(i + 6, 2).Borders(xlEdgeRight).LineStyle = xlContinuous
                        Cells(i + 6, 3).Borders(xlEdgeBottom).LineStyle = xlContinuous
                        m = m + 1
                    Else
                        Cells(i + 5, 2).Borders(xlEdgeRight).LineStyle = xlContinuous
                        Range(Cells(i + 4, 2), Cells(i + 5, 2)).Merge
                        With Cells(i + 4, 2)
                            .Value = match
                            .Font.Size = 8
                        End With
                        match = match + 1
                        m = m + 1
                    End If
                End If
            End If
         Next
         m = 0
         For i = 0 To player_left_first * 2 - 1
            li = Cells(i + 5, 3).Borders(xlEdgeBottom).LineStyle
            If m Mod 2 = 1 Then
                Cells(i + 5, 3).Borders(xlEdgeRight).LineStyle = xlContinuous
            End If
            If li = xlContinuous Then
                m = m + 1
            End If
         Next
        '右'
        '1,2段目'
        n = 0
        m = 0
        For i = 0 To player_right_first * 2 - 1
            If i Mod 2 = 0 Then
                Cells(i + 5, 9).Borders(xlEdgeBottom).LineStyle = xlContinuous
                n = i / 2
                If player_right_fourth0(n) = 0 Then
                    Cells(i + 5, 8).Borders(xlEdgeBottom).LineStyle = xlContinuous
                Else
                    If m Mod 2 = 0 Then
                        Cells(i + 6, 9).Borders(xlEdgeLeft).LineStyle = xlContinuous
                        Cells(i + 6, 8).Borders(xlEdgeBottom).LineStyle = xlContinuous
                        m = m + 1
                    Else
                        Cells(i + 5, 9).Borders(xlEdgeLeft).LineStyle = xlContinuous
                        Range(Cells(i + 4, 9), Cells(i + 5, 9)).Merge
                        With Cells(i + 4, 9)
                            .Value = match
                            .Font.Size = 8
                            .HorizontalAlignment = xlLeft
                        End With
                        match = match + 1
                        m = m + 1
                    End If
                End If
            End If
         Next
         m = 0
         For i = 0 To player_right_first * 2 - 1
            li = Cells(i + 5, 8).Borders(xlEdgeBottom).LineStyle
            If m Mod 2 = 1 Then
                Cells(i + 5, 8).Borders(xlEdgeLeft).LineStyle = xlContinuous
            End If
            If li = xlContinuous Then
                m = m + 1
            End If
         Next
        '3段目'
         '左'
         a = 0
         b = 0
         m = 0
         For i = 0 To 1
             a = player_left_second0(i)
             Cells(b + a + 4, 4).Borders(xlEdgeBottom).LineStyle = xlContinuous
             Range(Cells(b + a + 4, 3), Cells(b + a + 5, 3)).Merge
             With Cells(b + a + 4, 3)
                .Value = match
                .Font.Size = 8
             End With
             match = match + 1
             b = b + a * 2
         Next
         For i = 0 To player_left_first * 2 - 1
            li = Cells(i + 5, 4).Borders(xlEdgeBottom).LineStyle
            If m Mod 2 = 1 Then
                Cells(i + 5, 4).Borders(xlEdgeRight).LineStyle = xlContinuous
            End If
            If li = xlContinuous Then
                m = m + 1
            End If
         Next
         '3段目'
         '右'
         a = 0
         b = 0
         m = 0
         For i = 0 To 1
             a = player_right_second0(i)
             Cells(b + a + 4, 7).Borders(xlEdgeBottom).LineStyle = xlContinuous
             Range(Cells(b + a + 4, 8), Cells(b + a + 5, 8)).Merge
             With Cells(b + a + 4, 8)
                .Value = match
                .Font.Size = 8
                .HorizontalAlignment = xlLeft
             End With
             match = match + 1
             b = b + a * 2
         Next
         For i = 0 To player_right_first * 2 - 1
            li = Cells(i + 5, 7).Borders(xlEdgeBottom).LineStyle
            If m Mod 2 = 1 Then
                Cells(i + 5, 7).Borders(xlEdgeLeft).LineStyle = xlContinuous
            End If
            If li = xlContinuous Then
                m = m + 1
            End If
         Next
    End If
'16<32' If player_sum > 16 And player_sum <= 32 Then
        For i = 1 To 9
            Columns(3).Insert
        Next
    '決勝ボックスの作成'
        r = Application.RoundDown(player_sum / 2, 0)
        rll = Application.RoundDown(r / 2, 0)
        rl = rll * 2
        Range(Cells(rl + 3, 6), Cells(rl + 3, 7)).Merge
        With Cells(rl + 3, 6)
            .Value = "決勝"
            .Font.Size = 9
            .HorizontalAlignment = xlCenter
            .VerticalAlignment = xlCenter
        End With
        Cells(rl + 4, 6).Borders(xlEdgeRight).LineStyle = xlContinuous
        Cells(rl + 5, 6).Borders(xlEdgeTop).LineStyle = xlContinuous
        Cells(rl + 5, 7).Borders(xlEdgeTop).LineStyle = xlContinuous
        Range(Cells(rl + 4, 5), Cells(rl + 5, 5)).Merge
        With Cells(rl + 4, 5)
            .Value = player_sum - 3
            .Font.Size = 8
        End With
        Range(Cells(rl + 4, 8), Cells(rl + 5, 8)).Merge
        With Cells(rl + 4, 8)
            .Value = player_sum - 2
            .Font.Size = 8
            .HorizontalAlignment = xlLeft
        End With
        Range(Cells(rl + 5, 6), Cells(rl + 5, 7)).Merge
        With Cells(rl + 5, 6)
            .Value = player_sum
            .Font.Size = 8
            .HorizontalAlignment = xlCenter
            .VerticalAlignment = xlCenter
        End With
    '三決ボックスの作成'
        Range(Cells(player_sum + 4, 6), Cells(player_sum + 4, 7)).Merge
        With Cells(player_sum + 4, 6)
            .Value = "三決"
            .Font.Size = 9
            .HorizontalAlignment = xlCenter
            .VerticalAlignment = xlCenter
        End With
        Cells(player_sum + 5, 6).Borders(xlEdgeRight).LineStyle = xlContinuous
        With Cells(player_sum + 6, 6)
            .Borders(xlEdgeTop).LineStyle = xlContinuous
            .Borders(xlEdgeLeft).LineStyle = xlContinuous
        End With
        With Cells(player_sum + 6, 7)
            .Borders(xlEdgeTop).LineStyle = xlContinuous
            .Borders(xlEdgeRight).LineStyle = xlContinuous
        End With
        Range(Cells(player_sum + 6, 7), Cells(player_sum + 6, 6)).Merge
        With Cells(player_sum + 6, 6)
            .Value = player_sum - 1
            .Font.Size = 8
            .HorizontalAlignment = xlCenter
            .VerticalAlignment = xlCenter
        End With
    '完全二分木をつくる、左上、右上は普通、左下、右下は反転二分木'
    '1層'
        player_left_first = Application.RoundDown(player_sum / 2, 0)
        player_right_first = Application.RoundUp(player_sum / 2, 0)
    '左二分木 17から32までなら最下層は5層'
       '2層'
        '左'
        Dim player_left_second() As Integer
        ReDim player_left_second(1)
        player_left_second(0) = Application.RoundDown(player_left_first / 2, 0)
        player_left_second(1) = Application.RoundUp(player_left_first / 2, 0)
        '右'
        Dim player_right_second() As Integer
        ReDim player_right_second(1)
        player_right_second(0) = Application.RoundDown(player_right_first / 2, 0)
        player_right_second(1) = Application.RoundUp(player_right_first / 2, 0)
        '3層'
        '左'
        Dim player_left_third() As Integer
        ReDim player_left_third(3)
        player_left_third(0) = Application.RoundDown(player_left_second(0) / 2, 0)
        player_left_third(1) = Application.RoundUp(player_left_second(0) / 2, 0)
        player_left_third(2) = Application.RoundUp(player_left_second(1) / 2, 0)
        player_left_third(3) = Application.RoundDown(player_left_second(1) / 2, 0)
        '右'
        Dim player_right_third() As Integer
        ReDim player_right_third(3)
        player_right_third(0) = Application.RoundDown(player_right_second(0) / 2, 0)
        player_right_third(1) = Application.RoundUp(player_right_second(0) / 2, 0)
        player_right_third(2) = Application.RoundUp(player_right_second(1) / 2, 0)
        player_right_third(3) = Application.RoundDown(player_right_second(1) / 2, 0)
        '4層'
        '左'
        Dim player_left_fourth() As Integer
        ReDim player_left_fourth(7)
        For i = 0 To 7
            n = Application.RoundDown(i / 2, 0)
            If n Mod 2 = 0 Then
                If i Mod 2 = 0 Then
                    player_left_fourth(i) = Application.RoundDown(player_left_third(n) / 2, 0)
                Else
                    player_left_fourth(i) = Application.RoundUp(player_left_third(n) / 2, 0)
                End If
            Else
                If i Mod 2 = 0 Then
                    player_left_fourth(i) = Application.RoundUp(player_left_third(n) / 2, 0)
                Else
                    player_left_fourth(i) = Application.RoundDown(player_left_third(n) / 2, 0)
                End If
            End If
        Next
        For i = 0 To 7
           If player_left_fourth(i) = 2 Then
               nonseed = nonseed + 1
           End If
        Next
        '右'
        Dim player_right_fourth() As Integer
        ReDim player_right_fourth(7)
        For i = 0 To 7
            n = Application.RoundDown(i / 2, 0)
            If n Mod 2 = 0 Then
                If i Mod 2 = 0 Then
                    player_right_fourth(i) = Application.RoundDown(player_right_third(n) / 2, 0)
                Else
                    player_right_fourth(i) = Application.RoundUp(player_right_third(n) / 2, 0)
                End If
            Else
                If i Mod 2 = 0 Then
                    player_right_fourth(i) = Application.RoundUp(player_right_third(n) / 2, 0)
                Else
                    player_right_fourth(i) = Application.RoundDown(player_right_third(n) / 2, 0)
                End If
            End If
        Next
        r_nonseed = 0
        For i = 0 To 7
           If player_right_fourth(i) = 2 Then
               r_nonseed = r_nonseed + 1
           End If
        Next
        '5層'
        '左'
        Dim player_left_fifth() As Integer
        ReDim player_left_fifth(7 + nonseed)
        n = 0
        For i = 0 To 7
            If player_left_fourth(i) = 1 Then
                player_left_fifth(n) = 0
                n = n + 1
            Else
                player_left_fifth(n) = 1
                player_left_fifth(n + 1) = 1
                n = n + 2
            End If
        Next
        '右'
        Dim player_right_fifth() As Integer
        ReDim player_right_fifth(7 + r_nonseed)
        n = 0
        For i = 0 To 7
            If player_right_fourth(i) = 1 Then
                player_right_fifth(n) = 0
                n = n + 1
            Else
                player_right_fifth(n) = 1
                player_right_fifth(n + 1) = 1
                n = n + 2
            End If
        Next
        '二分木をもとにトーナメント表を作成'
        '左'
        '1,2段目'
        match = 1
        For i = 0 To player_left_first * 2 - 1
            If i Mod 2 = 0 Then
                Cells(i + 5, 2).Borders(xlEdgeBottom).LineStyle = xlContinuous
                n = i / 2
                If player_left_fifth(n) = 0 Then
                    Cells(i + 5, 3).Borders(xlEdgeBottom).LineStyle = xlContinuous
                Else
                    If m Mod 2 = 0 Then
                        Cells(i + 6, 2).Borders(xlEdgeRight).LineStyle = xlContinuous
                        Cells(i + 6, 3).Borders(xlEdgeBottom).LineStyle = xlContinuous
                        m = m + 1
                    Else
                        Cells(i + 5, 2).Borders(xlEdgeRight).LineStyle = xlContinuous
                        Range(Cells(i + 4, 2), Cells(i + 5, 2)).Merge
                        With Cells(i + 4, 2)
                            .Value = match
                            .Font.Size = 8
                        End With
                        match = match + 1
                        m = m + 1
                    End If
                End If
            End If
         Next
         m = 0
         For i = 0 To player_left_first * 2 - 1
            li = Cells(i + 5, 3).Borders(xlEdgeBottom).LineStyle
            If m Mod 2 = 1 Then
                Cells(i + 5, 3).Borders(xlEdgeRight).LineStyle = xlContinuous
            End If
            If li = xlContinuous Then
                m = m + 1
            End If
         Next
        '右'
        '1,2段目'
        For i = 0 To player_right_first * 2 - 1
            If i Mod 2 = 0 Then
                Cells(i + 5, 11).Borders(xlEdgeBottom).LineStyle = xlContinuous
                n = i / 2
                If player_right_fifth(n) = 0 Then
                    Cells(i + 5, 10).Borders(xlEdgeBottom).LineStyle = xlContinuous
                Else
                    If m Mod 2 = 0 Then
                        Cells(i + 6, 11).Borders(xlEdgeLeft).LineStyle = xlContinuous
                        Cells(i + 6, 10).Borders(xlEdgeBottom).LineStyle = xlContinuous
                        m = m + 1
                    Else
                        Cells(i + 5, 11).Borders(xlEdgeLeft).LineStyle = xlContinuous
                        Range(Cells(i + 4, 11), Cells(i + 5, 11)).Merge
                        With Cells(i + 4, 11)
                            .Value = match
                            .Font.Size = 8
                            .HorizontalAlignment = xlLeft
                        End With
                        match = match + 1
                        m = m + 1
                    End If
                End If
            End If
         Next
         m = 0
         For i = 0 To player_right_first * 2 - 1
            li = Cells(i + 5, 10).Borders(xlEdgeBottom).LineStyle
            If m Mod 2 = 1 Then
                Cells(i + 5, 10).Borders(xlEdgeLeft).LineStyle = xlContinuous
            End If
            If li = xlContinuous Then
                m = m + 1
            End If
         Next
         '3段目'
         '左'
         a = 0
         b = 0
         m = 0
         For i = 0 To 3
             a = player_left_third(i)
             Cells(b + a + 4, 4).Borders(xlEdgeBottom).LineStyle = xlContinuous
             Range(Cells(b + a + 4, 3), Cells(b + a + 5, 3)).Merge
             With Cells(b + a + 4, 3)
                .Value = match
                .Font.Size = 8
             End With
             match = match + 1
             b = b + a * 2
         Next
         For i = 0 To player_left_first * 2 - 1
            li = Cells(i + 5, 4).Borders(xlEdgeBottom).LineStyle
            If m Mod 2 = 1 Then
                Cells(i + 5, 4).Borders(xlEdgeRight).LineStyle = xlContinuous
            End If
            If li = xlContinuous Then
                m = m + 1
            End If
         Next
         '3段目'
         '右'
         a = 0
         b = 0
         m = 0
         For i = 0 To 3
             a = player_right_third(i)
             Cells(b + a + 4, 9).Borders(xlEdgeBottom).LineStyle = xlContinuous
             Range(Cells(b + a + 4, 10), Cells(b + a + 5, 10)).Merge
             With Cells(b + a + 4, 10)
                .Value = match
                .Font.Size = 8
                .HorizontalAlignment = xlLeft
             End With
             match = match + 1
             b = b + a * 2
         Next
         For i = 0 To player_right_first * 2 - 1
            li = Cells(i + 5, 9).Borders(xlEdgeBottom).LineStyle
            If m Mod 2 = 1 Then
                Cells(i + 5, 9).Borders(xlEdgeLeft).LineStyle = xlContinuous
            End If
            If li = xlContinuous Then
                m = m + 1
            End If
         Next
         '4段目'
         '左'
        a = 0
         b = 0
         m = 0
         For i = 0 To 1
             a = player_left_second(i)
             Cells(b + a + 4, 5).Borders(xlEdgeBottom).LineStyle = xlContinuous
             Range(Cells(b + a + 4, 4), Cells(b + a + 5, 4)).Merge
             With Cells(b + a + 4, 4)
                .Value = match
                .Font.Size = 8
             End With
             match = match + 1
             b = b + a * 2
         Next
         For i = 0 To player_left_first * 2 - 1
            li = Cells(i + 5, 5).Borders(xlEdgeBottom).LineStyle
            If m Mod 2 = 1 Then
                Cells(i + 5, 5).Borders(xlEdgeRight).LineStyle = xlContinuous
            End If
            If li = xlContinuous Then
                m = m + 1
            End If
         Next
         '4段目'
        a = 0
         b = 0
         m = 0
         For i = 0 To 1
             a = player_right_second(i)
             Cells(b + a + 4, 8).Borders(xlEdgeBottom).LineStyle = xlContinuous
             Range(Cells(b + a + 4, 9), Cells(b + a + 5, 9)).Merge
             With Cells(b + a + 4, 9)
                .Value = match
                .Font.Size = 8
                .HorizontalAlignment = xlLeft
             End With
             match = match + 1
             b = b + a * 2
         Next
         For i = 0 To player_right_first * 2 - 1
            li = Cells(i + 5, 8).Borders(xlEdgeBottom).LineStyle
            If m Mod 2 = 1 Then
                Cells(i + 5, 8).Borders(xlEdgeLeft).LineStyle = xlContinuous
            End If
            If li = xlContinuous Then
                m = m + 1
            End If
         Next
    End If
'32<64' If player_sum > 32 And player_sum <= 64 Then
        For i = 1 To 11
            Columns(3).Insert
        Next
    '決勝ボックスの作成'
        r = Application.RoundDown(player_sum / 2, 0)
        rll = Application.RoundDown(r / 2, 0)
        rl = rll * 2
        Range(Cells(rl + 3, 7), Cells(rl + 3, 8)).Merge
        With Cells(rl + 3, 7)
            .Value = "決勝"
            .Font.Size = 9
            .HorizontalAlignment = xlCenter
            .VerticalAlignment = xlCenter
        End With
        Cells(rl + 4, 7).Borders(xlEdgeRight).LineStyle = xlContinuous
        Cells(rl + 5, 7).Borders(xlEdgeTop).LineStyle = xlContinuous
        Cells(rl + 5, 8).Borders(xlEdgeTop).LineStyle = xlContinuous
        Range(Cells(rl + 4, 6), Cells(rl + 5, 6)).Merge
        With Cells(rl + 4, 6)
            .Value = player_sum - 3
            .Font.Size = 8
        End With
        Range(Cells(rl + 4, 9), Cells(rl + 5, 9)).Merge
        With Cells(rl + 4, 9)
            .Value = player_sum - 2
            .Font.Size = 8
            .HorizontalAlignment = xlLeft
        End With
        Range(Cells(rl + 5, 7), Cells(rl + 5, 8)).Merge
        With Cells(rl + 5, 7)
            .Value = player_sum
            .Font.Size = 8
            .HorizontalAlignment = xlCenter
            .VerticalAlignment = xlCenter
        End With
    '三決ボックスの作成'
        Range(Cells(player_sum + 4, 7), Cells(player_sum + 4, 8)).Merge
        With Cells(player_sum + 4, 7)
            .Value = "三決"
            .Font.Size = 9
            .HorizontalAlignment = xlCenter
            .VerticalAlignment = xlCenter
        End With
        Cells(player_sum + 5, 7).Borders(xlEdgeRight).LineStyle = xlContinuous
        With Cells(player_sum + 6, 7)
            .Borders(xlEdgeTop).LineStyle = xlContinuous
            .Borders(xlEdgeLeft).LineStyle = xlContinuous
        End With
        With Cells(player_sum + 6, 8)
            .Borders(xlEdgeTop).LineStyle = xlContinuous
            .Borders(xlEdgeRight).LineStyle = xlContinuous
        End With
        Range(Cells(player_sum + 6, 8), Cells(player_sum + 6, 7)).Merge
        With Cells(player_sum + 6, 7)
            .Value = player_sum - 1
            .Font.Size = 8
            .HorizontalAlignment = xlCenter
            .VerticalAlignment = xlCenter
        End With
    '完全二分木をつくる、左上、右上は普通、左下、右下は反転二分木'
    '1層'
        player_left_first2 = Application.RoundDown(player_sum / 2, 0)
        player_right_first2 = Application.RoundUp(player_sum / 2, 0)
    '左二分木 17から32までなら最下層は5層'
       '2層'
        '左'
        Dim player_left_second2() As Integer
        ReDim player_left_second2(1)
        player_left_second2(0) = Application.RoundDown(player_left_first2 / 2, 0)
        player_left_second2(1) = Application.RoundUp(player_left_first2 / 2, 0)
        '右'
        Dim player_right_second2() As Integer
        ReDim player_right_second2(1)
        player_right_second2(0) = Application.RoundDown(player_right_first2 / 2, 0)
        player_right_second2(1) = Application.RoundUp(player_right_first2 / 2, 0)
        '3層'
        '左'
        Dim player_left_third2() As Integer
        ReDim player_left_third2(3)
        player_left_third2(0) = Application.RoundDown(player_left_second2(0) / 2, 0)
        player_left_third2(1) = Application.RoundUp(player_left_second2(0) / 2, 0)
        player_left_third2(2) = Application.RoundUp(player_left_second2(1) / 2, 0)
        player_left_third2(3) = Application.RoundDown(player_left_second2(1) / 2, 0)
        '右'
        Dim player_right_third2() As Integer
        ReDim player_right_third2(3)
        player_right_third2(0) = Application.RoundDown(player_right_second2(0) / 2, 0)
        player_right_third2(1) = Application.RoundUp(player_right_second2(0) / 2, 0)
        player_right_third2(2) = Application.RoundUp(player_right_second2(1) / 2, 0)
        player_right_third2(3) = Application.RoundDown(player_right_second2(1) / 2, 0)
        '4層'
        '左'
        Dim player_left_fourth2() As Integer
        ReDim player_left_fourth2(7)
        For i = 0 To 7
            n = Application.RoundDown(i / 2, 0)
            If n Mod 2 = 0 Then
                If i Mod 2 = 0 Then
                    player_left_fourth2(i) = Application.RoundDown(player_left_third2(n) / 2, 0)
                Else
                    player_left_fourth2(i) = Application.RoundUp(player_left_third2(n) / 2, 0)
                End If
            Else
                If i Mod 2 = 0 Then
                    player_left_fourth2(i) = Application.RoundUp(player_left_third2(n) / 2, 0)
                Else
                    player_left_fourth2(i) = Application.RoundDown(player_left_third2(n) / 2, 0)
                End If
            End If
        Next
        '右'
        Dim player_right_fourth2() As Integer
        ReDim player_right_fourth2(7)
        For i = 0 To 7
            n = Application.RoundDown(i / 2, 0)
            If n Mod 2 = 0 Then
                If i Mod 2 = 0 Then
                    player_right_fourth2(i) = Application.RoundDown(player_right_third2(n) / 2, 0)
                Else
                    player_right_fourth2(i) = Application.RoundUp(player_right_third2(n) / 2, 0)
                End If
            Else
                If i Mod 2 = 0 Then
                    player_right_fourth2(i) = Application.RoundUp(player_right_third2(n) / 2, 0)
                Else
                    player_right_fourth2(i) = Application.RoundDown(player_right_third2(n) / 2, 0)
                End If
            End If
        Next
        '5層'
        '左'
        Dim player_left_fifth2() As Integer
        ReDim player_left_fifth2(15)
        nonseed = 0
        For i = 0 To 15
            n = Application.RoundDown(i / 2, 0)
            If n < 2 Then
                If i Mod 2 = 0 Then
                    player_left_fifth2(i) = Application.RoundDown(player_left_fourth2(n) / 2, 0)
                Else
                    player_left_fifth2(i) = Application.RoundUp(player_left_fourth2(n) / 2, 0)
                End If
            ElseIf n < 4 Then
                If i Mod 2 = 0 Then
                    player_left_fifth2(i) = Application.RoundUp(player_left_fourth2(n) / 2, 0)
                Else
                    player_left_fifth2(i) = Application.RoundDown(player_left_fourth2(n) / 2, 0)
                End If
            ElseIf n < 6 Then
                If i Mod 2 = 0 Then
                    player_left_fifth2(i) = Application.RoundDown(player_left_fourth2(n) / 2, 0)
                Else
                    player_left_fifth2(i) = Application.RoundUp(player_left_fourth2(n) / 2, 0)
                End If
            ElseIf n < 8 Then
                If i Mod 2 = 0 Then
                    player_left_fifth2(i) = Application.RoundUp(player_left_fourth2(n) / 2, 0)
                Else
                    player_left_fifth2(i) = Application.RoundDown(player_left_fourth2(n) / 2, 0)
                End If
            End If
        Next
        For i = 0 To 15
           If player_left_fifth2(i) = 2 Then
               nonseed = nonseed + 1
           End If
        Next
        '右'
        Dim player_right_fifth2() As Integer
        ReDim player_right_fifth2(15)
        For i = 0 To 15
            n = Application.RoundDown(i / 2, 0)
            If n < 2 = 0 Then
                If i Mod 2 = 0 Then
                    player_right_fifth2(i) = Application.RoundDown(player_right_fourth2(n) / 2, 0)
                Else
                    player_right_fifth2(i) = Application.RoundUp(player_right_fourth2(n) / 2, 0)
                End If
            ElseIf n < 4 Then
                If i Mod 2 = 0 Then
                    player_right_fifth2(i) = Application.RoundUp(player_right_fourth2(n) / 2, 0)
                Else
                    player_right_fifth2(i) = Application.RoundDown(player_right_fourth2(n) / 2, 0)
                End If
            ElseIf n < 6 Then
                If i Mod 2 = 0 Then
                    player_right_fifth2(i) = Application.RoundDown(player_right_fourth2(n) / 2, 0)
                Else
                    player_right_fifth2(i) = Application.RoundUp(player_right_fourth2(n) / 2, 0)
                End If
           ElseIf n < 8 Then
                If i Mod 2 = 0 Then
                    player_right_fifth2(i) = Application.RoundUp(player_right_fourth2(n) / 2, 0)
                Else
                    player_right_fifth2(i) = Application.RoundDown(player_right_fourth2(n) / 2, 0)
                End If
            End If
        Next
        r_nonseed = 0
        For i = 0 To 15
           If player_right_fifth2(i) = 2 Then
               r_nonseed = r_nonseed + 1
           End If
        Next
        '6層'
        '左'
        Dim player_left_sixth2() As Integer
        ReDim player_left_sixth2(15 + nonseed)
        n = 0
        For i = 0 To 15
            If player_left_fifth2(i) = 1 Then
                player_left_sixth2(n) = 0
                n = n + 1
            Else
                player_left_sixth2(n) = 1
                player_left_sixth2(n + 1) = 1
                n = n + 2
            End If
        Next
        '右'
        Dim player_right_sixth2() As Integer
        ReDim player_right_sixth2(15 + r_nonseed)
        n = 0
        For i = 0 To 15
            If player_right_fifth2(i) = 1 Then
                player_right_sixth2(n) = 0
                n = n + 1
            Else
                player_right_sixth2(n) = 1
                player_right_sixth2(n + 1) = 1
                n = n + 2
            End If
        Next
        '二分木をもとにトーナメント表を作成'
        '左'
        '1,2段目'
        match = 1
        n = 0
        m = 0
        For i = 0 To player_left_first2 * 2 - 1
            If i Mod 2 = 0 Then
                Cells(i + 5, 2).Borders(xlEdgeBottom).LineStyle = xlContinuous
                n = i / 2
                If player_left_sixth2(n) = 0 Then
                    Cells(i + 5, 3).Borders(xlEdgeBottom).LineStyle = xlContinuous
                Else
                    If m Mod 2 = 0 Then
                        Cells(i + 6, 2).Borders(xlEdgeRight).LineStyle = xlContinuous
                        Cells(i + 6, 3).Borders(xlEdgeBottom).LineStyle = xlContinuous
                        m = m + 1
                    Else
                        Cells(i + 5, 2).Borders(xlEdgeRight).LineStyle = xlContinuous
                        Range(Cells(i + 4, 2), Cells(i + 5, 2)).Merge
                        With Cells(i + 4, 2)
                            .Value = match
                            .Font.Size = 8
                        End With
                        match = match + 1
                        m = m + 1
                    End If
                End If
            End If
         Next
         m = 0
         For i = 0 To player_left_first2 * 2 - 1
            li = Cells(i + 5, 3).Borders(xlEdgeBottom).LineStyle
            If m Mod 2 = 1 Then
                Cells(i + 5, 3).Borders(xlEdgeRight).LineStyle = xlContinuous
            End If
            If li = xlContinuous Then
                m = m + 1
            End If
         Next
        '右'
        '1,2段目'
        n = 0
        m = 0
        For i = 0 To player_right_first2 * 2 - 1
            If i Mod 2 = 0 Then
                Cells(i + 5, 13).Borders(xlEdgeBottom).LineStyle = xlContinuous
                n = i / 2
                If player_right_sixth2(n) = 0 Then
                    Cells(i + 5, 12).Borders(xlEdgeBottom).LineStyle = xlContinuous
                Else
                    If m Mod 2 = 0 Then
                        Cells(i + 6, 13).Borders(xlEdgeLeft).LineStyle = xlContinuous
                        Cells(i + 6, 12).Borders(xlEdgeBottom).LineStyle = xlContinuous
                        m = m + 1
                    Else
                        Cells(i + 5, 13).Borders(xlEdgeLeft).LineStyle = xlContinuous
                        Range(Cells(i + 4, 13), Cells(i + 5, 13)).Merge
                        With Cells(i + 4, 13)
                            .Value = match
                            .Font.Size = 8
                            .HorizontalAlignment = xlLeft
                        End With
                        match = match + 1
                        m = m + 1
                    End If
                End If
            End If
         Next
         m = 0
         For i = 0 To player_right_first2 * 2 - 1
            li = Cells(i + 5, 12).Borders(xlEdgeBottom).LineStyle
            If m Mod 2 = 1 Then
                Cells(i + 5, 12).Borders(xlEdgeLeft).LineStyle = xlContinuous
            End If
            If li = xlContinuous Then
                m = m + 1
            End If
         Next
         '3段目'
         '左'
         a = 0
         b = 0
         m = 0
         For i = 0 To 7
             a = player_left_fourth2(i)
             Cells(b + a + 4, 4).Borders(xlEdgeBottom).LineStyle = xlContinuous
             Range(Cells(b + a + 4, 3), Cells(b + a + 5, 3)).Merge
             With Cells(b + a + 4, 3)
                .Value = match
                .Font.Size = 8
             End With
             match = match + 1
             b = b + a * 2
         Next
         For i = 0 To player_left_first2 * 2 - 1
            li = Cells(i + 5, 4).Borders(xlEdgeBottom).LineStyle
            If m Mod 2 = 1 Then
                Cells(i + 5, 4).Borders(xlEdgeRight).LineStyle = xlContinuous
            End If
            If li = xlContinuous Then
                m = m + 1
            End If
         Next
         '3段目'
         '右'
         a = 0
         b = 0
         m = 0
         For i = 0 To 7
             a = player_right_fourth2(i)
             Cells(b + a + 4, 11).Borders(xlEdgeBottom).LineStyle = xlContinuous
             Range(Cells(b + a + 4, 12), Cells(b + a + 5, 12)).Merge
             With Cells(b + a + 4, 12)
                .Value = match
                .Font.Size = 8
                .HorizontalAlignment = xlLeft
             End With
             match = match + 1
             b = b + a * 2
         Next
         For i = 0 To player_right_first2 * 2 - 1
            li = Cells(i + 5, 11).Borders(xlEdgeBottom).LineStyle
            If m Mod 2 = 1 Then
                Cells(i + 5, 11).Borders(xlEdgeLeft).LineStyle = xlContinuous
            End If
            If li = xlContinuous Then
                m = m + 1
            End If
         Next
         '4段目'
         '左'
        a = 0
         b = 0
         m = 0
         For i = 0 To 3
             a = player_left_third2(i)
             Cells(b + a + 4, 5).Borders(xlEdgeBottom).LineStyle = xlContinuous
             Range(Cells(b + a + 4, 4), Cells(b + a + 5, 4)).Merge
             With Cells(b + a + 4, 4)
                .Value = match
                .Font.Size = 8
             End With
             match = match + 1
             b = b + a * 2
         Next
         For i = 0 To player_left_first2 * 2 - 1
            li = Cells(i + 5, 5).Borders(xlEdgeBottom).LineStyle
            If m Mod 2 = 1 Then
                Cells(i + 5, 5).Borders(xlEdgeRight).LineStyle = xlContinuous
            End If
            If li = xlContinuous Then
                m = m + 1
            End If
         Next
         '4段目'
         '右'
        a = 0
         b = 0
         m = 0
         For i = 0 To 3
             a = player_right_third2(i)
             Cells(b + a + 4, 10).Borders(xlEdgeBottom).LineStyle = xlContinuous
             Range(Cells(b + a + 4, 11), Cells(b + a + 5, 11)).Merge
             With Cells(b + a + 4, 11)
                .Value = match
                .Font.Size = 8
                .HorizontalAlignment = xlLeft
             End With
             match = match + 1
             b = b + a * 2
         Next
         For i = 0 To player_right_first2 * 2 - 1
            li = Cells(i + 5, 10).Borders(xlEdgeBottom).LineStyle
            If m Mod 2 = 1 Then
                Cells(i + 5, 10).Borders(xlEdgeLeft).LineStyle = xlContinuous
            End If
            If li = xlContinuous Then
                m = m + 1
            End If
         Next
         '5段目'
         '左'
        a = 0
         b = 0
         m = 0
         For i = 0 To 1
             a = player_left_second2(i)
             Cells(b + a + 4, 6).Borders(xlEdgeBottom).LineStyle = xlContinuous
             Range(Cells(b + a + 4, 5), Cells(b + a + 5, 5)).Merge
             With Cells(b + a + 4, 5)
                .Value = match
                .Font.Size = 8
             End With
             match = match + 1
             b = b + a * 2
         Next
         For i = 0 To player_left_first2 * 2 - 1
            li = Cells(i + 5, 6).Borders(xlEdgeBottom).LineStyle
            If m Mod 2 = 1 Then
                Cells(i + 5, 6).Borders(xlEdgeRight).LineStyle = xlContinuous
            End If
            If li = xlContinuous Then
                m = m + 1
            End If
         Next
         '5段目'
         '右'
        a = 0
         b = 0
         m = 0
         For i = 0 To 1
             a = player_right_second2(i)
             Cells(b + a + 4, 9).Borders(xlEdgeBottom).LineStyle = xlContinuous
             Range(Cells(b + a + 4, 10), Cells(b + a + 5, 10)).Merge
             With Cells(b + a + 4, 10)
                .Value = match
                .Font.Size = 8
                .HorizontalAlignment = xlLeft
             End With
             match = match + 1
             b = b + a * 2
         Next
         For i = 0 To player_right_first2 * 2 - 1
            li = Cells(i + 5, 9).Borders(xlEdgeBottom).LineStyle
            If m Mod 2 = 1 Then
                Cells(i + 5, 9).Borders(xlEdgeLeft).LineStyle = xlContinuous
            End If
            If li = xlContinuous Then
                m = m + 1
            End If
         Next
    End If
'64<128' If player_sum > 64 And player_sum <= 128 Then
            For i = 1 To 13
                Columns(3).Insert
            Next
    '決勝ボックスの作成'
        r = Application.RoundDown(player_sum / 2, 0)
        rll = Application.RoundDown(r / 2, 0)
        rl = rll * 2
        Range(Cells(rl + 3, 8), Cells(rl + 3, 9)).Merge
        With Cells(rl + 3, 8)
            .Value = "決勝"
            .Font.Size = 9
            .HorizontalAlignment = xlCenter
            .VerticalAlignment = xlCenter
        End With
        Cells(rl + 4, 8).Borders(xlEdgeRight).LineStyle = xlContinuous
        Cells(rl + 5, 8).Borders(xlEdgeTop).LineStyle = xlContinuous
        Cells(rl + 5, 9).Borders(xlEdgeTop).LineStyle = xlContinuous
        Range(Cells(rl + 4, 7), Cells(rl + 5, 7)).Merge
        With Cells(rl + 4, 7)
            .Value = player_sum - 3
            .Font.Size = 8
        End With
        Range(Cells(rl + 4, 10), Cells(rl + 5, 10)).Merge
        With Cells(rl + 4, 10)
            .Value = player_sum - 2
            .Font.Size = 8
            .HorizontalAlignment = xlLeft
        End With
        Range(Cells(rl + 5, 8), Cells(rl + 5, 9)).Merge
        With Cells(rl + 5, 8)
            .Value = player_sum
            .Font.Size = 8
            .HorizontalAlignment = xlCenter
            .VerticalAlignment = xlCenter
        End With
    '三決ボックスの作成'
        Range(Cells(player_sum + 4, 8), Cells(player_sum + 4, 9)).Merge
        With Cells(player_sum + 4, 8)
            .Value = "三決"
            .Font.Size = 9
            .HorizontalAlignment = xlCenter
            .VerticalAlignment = xlCenter
        End With
        Cells(player_sum + 5, 8).Borders(xlEdgeRight).LineStyle = xlContinuous
        With Cells(player_sum + 6, 8)
            .Borders(xlEdgeTop).LineStyle = xlContinuous
            .Borders(xlEdgeLeft).LineStyle = xlContinuous
        End With
        With Cells(player_sum + 6, 9)
            .Borders(xlEdgeTop).LineStyle = xlContinuous
            .Borders(xlEdgeRight).LineStyle = xlContinuous
        End With
        Range(Cells(player_sum + 6, 8), Cells(player_sum + 6, 9)).Merge
        With Cells(player_sum + 6, 8)
            .Value = player_sum - 1
            .Font.Size = 8
            .HorizontalAlignment = xlCenter
            .VerticalAlignment = xlCenter
        End With
    '完全二分木をつくる、左上、右上は普通、左下、右下は反転二分木'
    '1層'
        player_left_first3 = Application.RoundDown(player_sum / 2, 0)
        player_right_first3 = Application.RoundUp(player_sum / 2, 0)
    '左二分木 17から32までなら最下層は5層'
       '2層'
        '左'
        Dim player_left_second3() As Integer
        ReDim player_left_second3(1)
        player_left_second3(0) = Application.RoundDown(player_left_first3 / 2, 0)
        player_left_second3(1) = Application.RoundUp(player_left_first3 / 2, 0)
        '右'
        Dim player_right_second3() As Integer
        ReDim player_right_second3(1)
        player_right_second3(0) = Application.RoundDown(player_right_first3 / 2, 0)
        player_right_second3(1) = Application.RoundUp(player_right_first3 / 2, 0)
        '3層'
        '左'
        Dim player_left_third3() As Integer
        ReDim player_left_third3(3)
        player_left_third3(0) = Application.RoundDown(player_left_second3(0) / 2, 0)
        player_left_third3(1) = Application.RoundUp(player_left_second3(0) / 2, 0)
        player_left_third3(2) = Application.RoundUp(player_left_second3(1) / 2, 0)
        player_left_third3(3) = Application.RoundDown(player_left_second3(1) / 2, 0)
        '右'
        Dim player_right_third3() As Integer
        ReDim player_right_third3(3)
        player_right_third3(0) = Application.RoundDown(player_right_second3(0) / 2, 0)
        player_right_third3(1) = Application.RoundUp(player_right_second3(0) / 2, 0)
        player_right_third3(2) = Application.RoundUp(player_right_second3(1) / 2, 0)
        player_right_third3(3) = Application.RoundDown(player_right_second3(1) / 2, 0)
        '4層'
        '左'
        Dim player_left_fourth2() As Integer
        ReDim player_left_fourth2(7)
        For i = 0 To 7
            n = Application.RoundDown(i / 2, 0)
            If n Mod 2 = 0 Then
                If i Mod 2 = 0 Then
                    player_left_fourth2(i) = Application.RoundDown(player_left_third3(n) / 2, 0)
                Else
                    player_left_fourth2(i) = Application.RoundUp(player_left_third3(n) / 2, 0)
                End If
            Else
                If i Mod 2 = 0 Then
                    player_left_fourth2(i) = Application.RoundUp(player_left_third3(n) / 2, 0)
                Else
                    player_left_fourth2(i) = Application.RoundDown(player_left_third3(n) / 2, 0)
                End If
            End If
        Next
        '右'
        Dim player_right_fourth2() As Integer
        ReDim player_right_fourth2(7)
        For i = 0 To 7
            n = Application.RoundDown(i / 2, 0)
            If n Mod 2 = 0 Then
                If i Mod 2 = 0 Then
                    player_right_fourth2(i) = Application.RoundDown(player_right_third3(n) / 2, 0)
                Else
                    player_right_fourth2(i) = Application.RoundUp(player_right_third3(n) / 2, 0)
                End If
            Else
                If i Mod 2 = 0 Then
                    player_right_fourth2(i) = Application.RoundUp(player_right_third3(n) / 2, 0)
                Else
                    player_right_fourth2(i) = Application.RoundDown(player_right_third3(n) / 2, 0)
                End If
            End If
        Next
        '5層'
        '左'
        Dim player_left_fifth2() As Integer
        ReDim player_left_fifth2(15)
        nonseed = 0
        For i = 0 To 15
            n = Application.RoundDown(i / 2, 0)
            If n < 2 Then
                If i Mod 2 = 0 Then
                    player_left_fifth2(i) = Application.RoundDown(player_left_fourth2(n) / 2, 0)
                Else
                    player_left_fifth2(i) = Application.RoundUp(player_left_fourth2(n) / 2, 0)
                End If
            ElseIf n < 4 Then
                If i Mod 2 = 0 Then
                    player_left_fifth2(i) = Application.RoundUp(player_left_fourth2(n) / 2, 0)
                Else
                    player_left_fifth2(i) = Application.RoundDown(player_left_fourth2(n) / 2, 0)
                End If
            ElseIf n < 6 Then
                If i Mod 2 = 0 Then
                    player_left_fifth2(i) = Application.RoundDown(player_left_fourth2(n) / 2, 0)
                Else
                    player_left_fifth2(i) = Application.RoundUp(player_left_fourth2(n) / 2, 0)
                End If
            ElseIf n < 8 Then
                If i Mod 2 = 0 Then
                    player_left_fifth2(i) = Application.RoundUp(player_left_fourth2(n) / 2, 0)
                Else
                    player_left_fifth2(i) = Application.RoundDown(player_left_fourth2(n) / 2, 0)
                End If
            End If
        Next
        '右'
        Dim player_right_fifth2() As Integer
        ReDim player_right_fifth2(15)
        For i = 0 To 15
            n = Application.RoundDown(i / 2, 0)
            If n < 2 = 0 Then
                If i Mod 2 = 0 Then
                    player_right_fifth2(i) = Application.RoundDown(player_right_fourth2(n) / 2, 0)
                Else
                    player_right_fifth2(i) = Application.RoundUp(player_right_fourth2(n) / 2, 0)
                End If
            ElseIf n < 4 Then
                If i Mod 2 = 0 Then
                    player_right_fifth2(i) = Application.RoundUp(player_right_fourth2(n) / 2, 0)
                Else
                    player_right_fifth2(i) = Application.RoundDown(player_right_fourth2(n) / 2, 0)
                End If
            ElseIf n < 6 Then
                If i Mod 2 = 0 Then
                    player_right_fifth2(i) = Application.RoundDown(player_right_fourth2(n) / 2, 0)
                Else
                    player_right_fifth2(i) = Application.RoundUp(player_right_fourth2(n) / 2, 0)
                End If
           ElseIf n < 8 Then
                If i Mod 2 = 0 Then
                    player_right_fifth2(i) = Application.RoundUp(player_right_fourth2(n) / 2, 0)
                Else
                    player_right_fifth2(i) = Application.RoundDown(player_right_fourth2(n) / 2, 0)
                End If
            End If
        Next
        '6層'
        '左'
        Dim player_left_sixth2() As Integer
        ReDim player_left_sixth2(31)
        n = 0
        For i = 0 To 31
            n = Application.RoundDown(i / 2, 0)
            If n Mod 2 = 0 Then
                If i Mod 2 = 0 Then
                    player_left_sixth2(i) = Application.RoundDown(player_left_fifth2(n) / 2, 0)
                Else
                    player_left_sixth2(i) = Application.RoundUp(player_left_fifth2(n) / 2, 0)
                End If
            ElseIf n Mod 2 = 1 Then
                If i Mod 2 = 0 Then
                    player_left_sixth2(i) = Application.RoundUp(player_left_fifth2(n) / 2, 0)
                Else
                    player_left_sixth2(i) = Application.RoundDown(player_left_fifth2(n) / 2, 0)
                End If
            End If
        Next
        nonseed = 0
        For i = 0 To 31
           If player_left_sixth2(i) = 2 Then
               nonseed = nonseed + 1
           End If
        Next
        '右'
        Dim player_right_sixth2() As Integer
        ReDim player_right_sixth2(31)
        n = 0
        For i = 0 To 31
            n = Application.RoundDown(i / 2, 0)
            If n Mod 2 = 0 Then
                If i Mod 2 = 0 Then
                    player_right_sixth2(i) = Application.RoundDown(player_right_fifth2(n) / 2, 0)
                Else
                    player_right_sixth2(i) = Application.RoundUp(player_right_fifth2(n) / 2, 0)
                End If
            ElseIf n Mod 2 = 1 Then
                If i Mod 2 = 0 Then
                    player_right_sixth2(i) = Application.RoundUp(player_right_fifth2(n) / 2, 0)
                Else
                    player_right_sixth2(i) = Application.RoundDown(player_right_fifth2(n) / 2, 0)
                End If
            End If
        Next
        r_nonseed = 0
        For i = 0 To 31
           If player_right_sixth2(i) = 2 Then
               r_nonseed = r_nonseed + 1
           End If
        Next
        '7層'
        '左'
        Dim player_left_seventh2() As Integer
        ReDim player_left_seventh2(31 + nonseed)
        n = 0
        For i = 0 To 31
            If player_left_sixth2(i) = 1 Then
                player_left_seventh2(n) = 0
                n = n + 1
            Else
                player_left_seventh2(n) = 1
                player_left_seventh2(n + 1) = 1
                n = n + 2
            End If
        Next
        '右'
        Dim player_right_seventh2() As Integer
        ReDim player_right_seventh2(31 + r_nonseed)
        n = 0
        For i = 0 To 31
            If player_right_sixth2(i) = 1 Then
                player_right_seventh2(n) = 0
                n = n + 1
            Else
                player_right_seventh2(n) = 1
                player_right_seventh2(n + 1) = 1
                n = n + 2
            End If
        Next
        '二分木をもとにトーナメント表を作成'
        '左'
        '1,2段目'
        match = 1
        n = 0
        m = 0
        For i = 0 To player_left_first3 * 2 - 1
            If i Mod 2 = 0 Then
                Cells(i + 5, 2).Borders(xlEdgeBottom).LineStyle = xlContinuous
                n = i / 2
                If player_left_seventh2(n) = 0 Then
                    Cells(i + 5, 3).Borders(xlEdgeBottom).LineStyle = xlContinuous
                Else
                    If m Mod 2 = 0 Then
                        Cells(i + 6, 2).Borders(xlEdgeRight).LineStyle = xlContinuous
                        Cells(i + 6, 3).Borders(xlEdgeBottom).LineStyle = xlContinuous
                        m = m + 1
                    Else
                        Cells(i + 5, 2).Borders(xlEdgeRight).LineStyle = xlContinuous
                        Range(Cells(i + 4, 2), Cells(i + 5, 2)).Merge
                        With Cells(i + 4, 2)
                            .Value = match
                            .Font.Size = 8
                        End With
                        match = match + 1
                        m = m + 1
                    End If
                End If
            End If
         Next
         m = 0
         For i = 0 To player_left_first3 * 2 - 1
            li = Cells(i + 5, 3).Borders(xlEdgeBottom).LineStyle
            If m Mod 2 = 1 Then
                Cells(i + 5, 3).Borders(xlEdgeRight).LineStyle = xlContinuous
            End If
            If li = xlContinuous Then
                m = m + 1
            End If
         Next
        '右'
        '1,2段目'
        n = 0
        m = 0
        For i = 0 To player_right_first3 * 2 - 1
            If i Mod 2 = 0 Then
                Cells(i + 5, 15).Borders(xlEdgeBottom).LineStyle = xlContinuous
                n = i / 2
                If player_right_seventh2(n) = 0 Then
                    Cells(i + 5, 14).Borders(xlEdgeBottom).LineStyle = xlContinuous
                Else
                    If m Mod 2 = 0 Then
                        Cells(i + 6, 15).Borders(xlEdgeLeft).LineStyle = xlContinuous
                        Cells(i + 6, 14).Borders(xlEdgeBottom).LineStyle = xlContinuous
                        m = m + 1
                    Else
                        Cells(i + 5, 15).Borders(xlEdgeLeft).LineStyle = xlContinuous
                        Range(Cells(i + 4, 15), Cells(i + 5, 15)).Merge
                        With Cells(i + 4, 15)
                            .Value = match
                            .Font.Size = 8
                            .HorizontalAlignment = xlLeft
                        End With
                        match = match + 1
                        m = m + 1
                    End If
                End If
            End If
         Next
         m = 0
         For i = 0 To player_right_first3 * 2 - 1
            li = Cells(i + 5, 14).Borders(xlEdgeBottom).LineStyle
            If m Mod 2 = 1 Then
                Cells(i + 5, 14).Borders(xlEdgeLeft).LineStyle = xlContinuous
            End If
            If li = xlContinuous Then
                m = m + 1
            End If
         Next
         '3段目'
         '左'
         a = 0
         b = 0
         m = 0
         For i = 0 To 15
             a = player_left_fifth2(i)
             Cells(b + a + 4, 4).Borders(xlEdgeBottom).LineStyle = xlContinuous
             Range(Cells(b + a + 4, 3), Cells(b + a + 5, 3)).Merge
             With Cells(b + a + 4, 3)
                .Value = match
                .Font.Size = 8
             End With
             match = match + 1
             b = b + a * 2
         Next
         For i = 0 To player_left_first3 * 2 - 1
            li = Cells(i + 5, 4).Borders(xlEdgeBottom).LineStyle
            If m Mod 2 = 1 Then
                Cells(i + 5, 4).Borders(xlEdgeRight).LineStyle = xlContinuous
            End If
            If li = xlContinuous Then
                m = m + 1
            End If
         Next
         '3段目'
         '右'
         a = 0
         b = 0
         m = 0
         For i = 0 To 15
             a = player_right_fifth2(i)
             Cells(b + a + 4, 13).Borders(xlEdgeBottom).LineStyle = xlContinuous
             Range(Cells(b + a + 4, 14), Cells(b + a + 5, 14)).Merge
             With Cells(b + a + 4, 14)
                .Value = match
                .Font.Size = 8
                .HorizontalAlignment = xlLeft
             End With
             match = match + 1
             b = b + a * 2
         Next
         For i = 0 To player_right_first3 * 2 - 1
            li = Cells(i + 5, 13).Borders(xlEdgeBottom).LineStyle
            If m Mod 2 = 1 Then
                Cells(i + 5, 13).Borders(xlEdgeLeft).LineStyle = xlContinuous
            End If
            If li = xlContinuous Then
                m = m + 1
            End If
         Next
         '4段目'
         '左'
         a = 0
         b = 0
         m = 0
         For i = 0 To 7
             a = player_left_fourth2(i)
             Cells(b + a + 4, 5).Borders(xlEdgeBottom).LineStyle = xlContinuous
             Range(Cells(b + a + 4, 4), Cells(b + a + 5, 4)).Merge
             With Cells(b + a + 4, 4)
                .Value = match
                .Font.Size = 8
             End With
             match = match + 1
             b = b + a * 2
         Next
         For i = 0 To player_left_first3 * 2 - 1
            li = Cells(i + 5, 5).Borders(xlEdgeBottom).LineStyle
            If m Mod 2 = 1 Then
                Cells(i + 5, 5).Borders(xlEdgeRight).LineStyle = xlContinuous
            End If
            If li = xlContinuous Then
                m = m + 1
            End If
         Next
         '4段目'
         '右'
         a = 0
         b = 0
         m = 0
         For i = 0 To 7
             a = player_right_fourth2(i)
             Cells(b + a + 4, 12).Borders(xlEdgeBottom).LineStyle = xlContinuous
             Range(Cells(b + a + 4, 13), Cells(b + a + 5, 13)).Merge
             With Cells(b + a + 4, 13)
                .Value = match
                .Font.Size = 8
                .HorizontalAlignment = xlLeft
             End With
             match = match + 1
             b = b + a * 2
         Next
         For i = 0 To player_right_first3 * 2 - 1
            li = Cells(i + 5, 12).Borders(xlEdgeBottom).LineStyle
            If m Mod 2 = 1 Then
                Cells(i + 5, 12).Borders(xlEdgeLeft).LineStyle = xlContinuous
            End If
            If li = xlContinuous Then
                m = m + 1
            End If
         Next
         '5段目'
         '左'
         a = 0
         b = 0
         m = 0
         For i = 0 To 3
             a = player_left_third3(i)
             Cells(b + a + 4, 6).Borders(xlEdgeBottom).LineStyle = xlContinuous
             Range(Cells(b + a + 4, 5), Cells(b + a + 5, 5)).Merge
             With Cells(b + a + 4, 5)
                .Value = match
                .Font.Size = 8
             End With
             match = match + 1
             b = b + a * 2
         Next
         For i = 0 To player_left_first3 * 2 - 1
            li = Cells(i + 5, 6).Borders(xlEdgeBottom).LineStyle
            If m Mod 2 = 1 Then
                Cells(i + 5, 6).Borders(xlEdgeRight).LineStyle = xlContinuous
            End If
            If li = xlContinuous Then
                m = m + 1
            End If
         Next
         '5段目'
         '右'
         a = 0
         b = 0
         m = 0
         For i = 0 To 3
             a = player_right_third3(i)
             Cells(b + a + 4, 11).Borders(xlEdgeBottom).LineStyle = xlContinuous
             Range(Cells(b + a + 4, 12), Cells(b + a + 5, 12)).Merge
             With Cells(b + a + 4, 12)
                .Value = match
                .Font.Size = 8
                .HorizontalAlignment = xlLeft
             End With
             match = match + 1
             b = b + a * 2
         Next
         For i = 0 To player_right_first3 * 2 - 1
            li = Cells(i + 5, 11).Borders(xlEdgeBottom).LineStyle
            If m Mod 2 = 1 Then
                Cells(i + 5, 11).Borders(xlEdgeLeft).LineStyle = xlContinuous
            End If
            If li = xlContinuous Then
                m = m + 1
            End If
         Next
         '6段目'
         '左'
         a = 0
         b = 0
         m = 0
         For i = 0 To 1
             a = player_left_second3(i)
             Cells(b + a + 4, 7).Borders(xlEdgeBottom).LineStyle = xlContinuous
             Range(Cells(b + a + 4, 6), Cells(b + a + 5, 6)).Merge
             With Cells(b + a + 4, 6)
                .Value = match
                .Font.Size = 8
             End With
             match = match + 1
             b = b + a * 2
         Next
         For i = 0 To player_left_first3 * 2 - 1
            li = Cells(i + 5, 7).Borders(xlEdgeBottom).LineStyle
            If m Mod 2 = 1 Then
                Cells(i + 5, 7).Borders(xlEdgeRight).LineStyle = xlContinuous
            End If
            If li = xlContinuous Then
                m = m + 1
            End If
         Next
         '右'
         a = 0
         b = 0
         m = 0
         For i = 0 To 1
             a = player_right_second3(i)
             Cells(b + a + 4, 10).Borders(xlEdgeBottom).LineStyle = xlContinuous
             Range(Cells(b + a + 4, 11), Cells(b + a + 5, 11)).Merge
             With Cells(b + a + 4, 11)
                .Value = match
                .Font.Size = 8
             End With
             match = match + 1
             b = b + a * 2
         Next
         For i = 0 To player_right_first3 * 2 - 1
            li = Cells(i + 5, 10).Borders(xlEdgeBottom).LineStyle
            If m Mod 2 = 1 Then
                Cells(i + 5, 10).Borders(xlEdgeLeft).LineStyle = xlContinuous
            End If
            If li = xlContinuous Then
                m = m + 1
            End If
         Next
    End If
 End If
    Application.DisplayFormulaBar = False
    ActiveWindow.DisplayHeadings = False
    ActiveWindow.DisplayGridlines = False
End Sub