以前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
'完全二分木をつくる、左上、右上は普通、左下、右下は反転二分木'
'１層'
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
'完全二分木をつくる、左上、右上は普通、左下、右下は反転二分木'
'１層'
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
'完全二分木をつくる、左上、右上は普通、左下、右下は反転二分木'
'１層'
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
'完全二分木をつくる、左上、右上は普通、左下、右下は反転二分木'
'１層'
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
こんにちは
通りすがりの者ですが、ダウンロードしてみたかったです。
できなくて残念。
ご連絡ありがとうございます。
ご迷惑をおかけいたしました。
修正いたしましたので、よければぜひお使いください。