テニス（ダブルス）乱数表 Excelマクロ
テニス等のダブルスゲームのペアを決めるための乱数表を作りたいと思い、Web検索したところrio_dさんが作成されたExcelマクロプログラムを見つけました（http://oshiete1.goo.ne.jp/kotaeru.php3?q=1388951）。記載されている通りにマクロを作成しましたが、実行すると「SubまたはFunctionが定義されていません」というコンパイルエラーメッセージが出てしまいます。rio_dさんのマクロプログラムの最初に「Sub 乱数表作成()」がありますが、この（ ）の中に何かを入力する必要があるのでしょうか。この他にも空白の（ ）がいくつかあります。マクロについて全くの素人で何も分かりません。このrio_dさんのマクロプログラムを実行する方法を素人にも分かるように解説していただければ幸いです。
【rio_dさんが書かれたマクロは以下の通りです】
＜マクロ準備編＞
(1)新規ブックを開き、とりあえず名前をつけて保存します。『てにす乱数表.xls』にしましょうか。
(2)メニューバーから、ツール→マクロ→Visual Basic Editorを選択します。
Visual Basic Editorが起動します。
(3)左側に「VBAProject(てにす乱数表).xls」というのがあると思います。
ツリー状になっていて、左の[+]で展開していくと、「ThisWorkbook」という
ものが表示されると思います。
(4)その「ThisWorkbook」をダブルクリックします。
右側に「～～.xls - Thisworkbook(コード)」というウインドウが表示されます。
(5)そこに、下記のコードをコピー&ペーストしてください。
(6)Visual Basic Editorを閉じます。
(7)ここで一旦上書き保存しておきましょう。
＜データ準備編＞
(1)セルA1に、コート数を入力してください。数字でお願いします。
(2)セルB1から横方向に、人数を入れていってください。
(3)セルA2から縦方向に、試合数を入れていってください。
こんなかんじ
＿A＿＿B＿C＿D＿_E＿_F＿_G＿＿H＿＿I＿＿J＿＿K
1| 3 5 6 7 8 9 10 11 12 13 14…
2| 1
3| 2
4| 3
5| 4
6| 5
7| 6
：
＜データ作成編＞
(1)メニューバーから、ツール→マクロ→マクロ と選択してください。
(2)実行するマクロの一覧に「ThisWorkbook.乱数表作成」というのがでるので、
それを選択して「実行」してください。
(3)砂時計が消えたら完成です。
このマクロは実行するたびに結果が変わります。気に入らなかったら何度でも
やり直してください。
また、全セルを消去すれば、データ準備からやり直すことも出来ます。
好きな表をいくつでも作ってください。
ちなみに100人とかデータ数がえらく膨大になると、なかなか計算が終わりませんので。
その場合は気長に待ってください。
'-----マクロ ここから-----
Sub 乱数表作成()
Dim iRow As Integer
Dim iCol As Integer
Dim iCnt As Integer
Dim iCnt2 As Integer
Dim iTmp As Integer
Dim sNum() As String
Dim bChk() As Boolean
Dim bChk2() As Boolean
Dim bFull As Boolean
Dim iCourt As Integer
iCol = 2
Do Until Cells(1, iCol) = ""
iRow = 2
If Cells(1, 1) * 4 > Cells(1, iCol) Then
iCourt = Round(Cells(1, iCol) / 4 - 0.5, 0)
Else
iCourt = Cells(1, 1)
End If
ReDim sNum(iCourt * 4 - 1)
ReDim bChk(Cells(1, iCol))
ReDim bChk2(Cells(1, iCol))
For iCnt = 1 To Cells(1, iCol)
bChk(iCnt) = True
bChk2(iCnt) = True
Next iCnt
Do Until Cells(iRow, 1) = ""
iCnt = 0
Do Until iCnt = iCourt * 4
iTmp = Round(Rnd(Second(Now)) * Cells(1, iCol) + 0.5, 0)
If bChk(iTmp) And bChk2(iTmp) Then
sNum(iCnt) = "[" & Trim(Str(iTmp)) & "]"
iCnt = iCnt + 1
bChk(iTmp) = False
bChk2(iTmp) = False
bFull = False
For iCnt2 = 1 To Cells(1, iCol)
bFull = bFull Or bChk(iCnt2)
Next iCnt2
If bFull = False Then
For iCnt2 = 1 To Cells(1, iCol)
bChk(iCnt2) = True
Next iCnt2
End If
End If
Loop
Cells(iRow, iCol) = sNum(0)
For iCnt = 1 To iCourt * 4 - 1
Select Case iCnt Mod 4
Case 0
Cells(iRow, iCol) = Cells(iRow, iCol) & Chr(10) & sNum(iCnt)
Case 2
Cells(iRow, iCol) = Cells(iRow, iCol) & "：" & sNum(iCnt)
Case Else
Cells(iRow, iCol) = Cells(iRow, iCol) & sNum(iCnt)
End Select
Next iCnt
For iCnt = 1 To Cells(1, iCol)
bChk2(iCnt) = True
Next iCnt
iRow = iRow + 1
Loop
iCol = iCol + 1
Loop
End Sub
'-----マクロ ここまで-----
