テニス（ダブルス）乱数表 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
'-----マクロ　ここまで-----

No.1 ベストアンサー 回答者： DIooggooID 回答日時： 2009/08/17 11:07

> この（　）の中に何かを入力する必要があるのでしょうか？

　　　関数なので、カッコは、このままで構いません。【入力不要】

　rio_dさんの通りに、マクロを入力して実行させたところ、
下記のような結果になりました。

３　　　　　　　５　　　　　　　６　　　　　　　　７　　　　　　　　　　８

1　[4][3]：[2][1]　　[1][5]：[2][3]　　[1][2]：[7][3]　　[7][3]：[6][1]
　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　[2][4]：[5][8]

2　[5][4]：[1][3]　　[6][4]：[3][5]　　[4][5]：[6][1]　　[3][5]：[1][6]
　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　[4][8]：[2][7]

3　[5][2]：[1][3]　　[2][4]：[1][6]　　[2][3]：[4][5]　　[7][6]：[8][3]
　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　[4][2]：[5][1]

4　[4][2]：[5][3]　　[2][5]：[3][6]　　[6][7]：[4][1]　　[1][7]：[4][2]
　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　[6][5]：[8][3]

5　[5][2]：[4][1]　　[4][1]：[5][6]　　[6][3]：[2][5]　　[8][7]：[6][4]
　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　[3][1]：[2][5]

6　[5][4]：[1][3]　　[1][4]：[3][2]　　[7][1]：[4][2]　　[4][8]：[2][3]
　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　[5][6]：[1][7]

この回答へのお礼

DIooggooID様
驚くほど素早く回答していただき、有り難うございました。こんなに早く回答をいただけるとは思っていませんでした。大変感謝申し上げます。どうも私のMacではExcel（Office2004）のマクロが正常に作動しないようです。マクロを実行すると、常に「SubまたはFunctionが定義されていません」が表示され、Visual Basic Editorの「～～.xls - Thisworkbook(コード)」画面の最上段に表示される「Sub 乱数表作成( )」の部分がカラー表示になってしまいます。残念ですが、諦めるしか、なさそうですね。

お礼日時：2009/08/17 13:04

No.5 回答者： cistronezk 回答日時： 2009/08/18 09:27

＞iCourt = Round(Cells(1, iCol) / 4 - 0.5, 0)がエラーになる原因のようです。

Excel for Macの環境がないのでわかりませんが、Round関数がないのでしょうか？ちょっと考えにくいですが。ヘルプにもRound関数は載ってませんか？
あるいは、
Sub aa()
MsgBox Round(1.5, 0)
End Sub
で、本当にRoundが使えないのかを確認してみてください。

使えないのならとりあえず、
iCourt = Round(Cells(1, iCol) / 4 - 0.5, 0)
をコメント化してコピーを進めていき、エラーの度に問題の行をコメント化して全体がコピーできるかを確認してはどうでしょう？あとでコメント化した部分を個別に解決することにして。

しかし、一番速くて簡単なのは、お近くにいるWindowsのExcelを持っている人にマクロの実行をお願いすることかもしれませんが。

この回答へのお礼

cistronezk様

何回も御回答いただき、誠に有り難うございます。

Sub aa()
MsgBox Round(1.5, 0)
End Sub

で実行してもダメで、Roundが使えないようです。WindowsのExcelでマクロを実行するのが手っ取り早そうですね。ご親切に御回答していただき、感謝の言葉もありません。

お礼日時：2009/08/18 12:54

No.3 回答者： cistronezk 回答日時： 2009/08/17 19:00

＞Sub 乱数表作成()

＞End Sub
＞はエラーになりませんでした

では、そのサブルーチンへ、エラーになっているサブルーチンの中身を少しずつ（小さな処理単位で）コピーしては実行を繰り返してみてはどうでしょう？
ある程度、エラーの原因が絞り込めるかもしれません。

この回答へのお礼

cistronezk様
ご親切な回答、有り難うございました。大変恐縮しています。御指摘に従って少しずつペーストしていきましたところ、16行目の　If Cells(1, 1) * 4 > Cells(1, iCol) Then
iCourt = Round(Cells(1, iCol) / 4 - 0.5, 0)がエラーになる原因のようです。よく見ると、Roundが色字に変わっていますので、このコマンドがいけないと言うことかも知れません。

お礼日時：2009/08/17 20:01

No.2 回答者： cistronezk 回答日時： 2009/08/17 13:24

＞記載されている通りにマクロを作成しましたが、実行すると「SubまたはFunctionが定義されていません」というコンパイルエラーメッセージが出てしまいます。

そもそも、中身が何も書かれていないサブルーチン

Sub 乱数表作成()
End Sub

は、エラーになりますか？
もしなるなら、単なるヤマカンですが、サブルーチン名を漢字ではなく、アルファベットに変えてみては？

この回答へのお礼

cistronezk様
コメントを頂き有り難うございました。

Sub 乱数表作成()
End Sub

はエラーになりませんでした。また、漢字をアルファベットに変えてみましたが、やはり「SubまたはFunctionが定義されていません」が表示されました。私の知識が足らないことから、幼稚なやり取りになってしまい、申し訳ありません。基本的な設定等に不都合があるのかも知れませんね。

お礼日時：2009/08/17 14:33