テニス　乱数表

Question

テニスのダブルスゲームのときに使う乱数表を作りたいと思うのですが、10人までならインターネットで検索すると出てくるのですが、16～20人のは見つかりません。
過去の質問Ｑ352925に同じ質問が出ていたので見たのですが、そこにでている”参考にしたページ”が、すでになくなっていました。エクセルで作るのだと思いますが、教えてください。。パソコン初心者なので、こんなことも・・・と思うことが解からないかもしれませんが、よろしくお願いします。

rio_d · Accepted Answer

こんにちは。
ヒマなのでwwwwマクロ作りました。すんげぇ長文レスなので覚悟してくださいw

そもそも乱数表というものがよく判らないのですが、組み合わせの条件が相当複雑になります。
例えば下記のURL先の乱数表を見てください。
http://www.geocities.jp/ttc1jp/order.html
これの９人の列を見てほしいんですが、２コートで実施した場合、９回，１０回目のところで
６番さんが両コートでプレイしなければならなくなります。
９人などコート数が２コートだけで良いのであればこういうのも排除できるんですが、
１３人以上で２コートでも３コートでも出来てしまう場合、乱数表だけでは必ず６番さんのような
重複が発生してしまいます。

そこで、乱数表のフォーマットからちょびっと外れるかも知れないんですが、
(1)　最初にコート数を指定する
(2)　前回参加できなかった人(見学者)は次回に優先的に参加できる
(3)　ひとりの人を同時に別コートで試合という無茶はさせない
(4)　ランダムにこだわる
というマクロを作ってみました。

【つかいかた】
＜マクロ準備編＞
(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
'-----マクロ　ここまで-----

あー面白かったw　ナイス暇つぶし。

解らないところがあったら聞いてください。

dejiji- · Answer

A列はA1に１を入れる。セルの右下にカーソルを合わせると黒十字のカーソルに変化する。これを必要なところまでドラッグして離し、連続データをクリックすると連続した数値が出る。
B1に=RAND()と入れ、A列と同じ状態の黒十字を出し、今度は左クリックをして、下までドラッグ。（これでコピーできる。）
C1には一つずつ名前を入れる。

これで、A列の左上をクリックしてC列の右下までドラッグする。
これでセルの色が変わります。この状態でデータ→並べ替えを実行すれば、できます。
健闘を祈る！！

dejiji- · Answer

＞ＲＡＮＤの後の（）の中には
何も入れません。こういう関数もあるのです。
これで、入れた範囲を選択して、データ→並べ替えで優先されるキーにRANDを入れた列を選択して改行で変化します。
あとRANDは何か確定するたびに(改行などを押す）変化します。また並べ替えた時も、数値順に並びません。ただし、ばらばらに入れ替わります。

T0ngT0ng · Answer

たとえば
A列にメンバの名前
B列に=rand()   (乱数生成関数)
としてメンバ表を作ってB列のどこかを選択した状態で整列。
上から2人ずつペアにしていく。とかではどうでしょう?

テニス 乱数表

こんにちは。

A列はA1に１を入れる。

＞ＲＡＮＤの後の（）の中には

たとえば

このQ&Aを見た人はこんなQ&Aも見ています

関連するカテゴリからQ&Aを探す

このQ&Aを見た人がよく見るQ&A

デイリーランキングこのカテゴリの人気デイリーQ&Aランキング

マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング

テニス　乱数表