エクセルでランダムな麻雀用座席表を作りたい。

各チーム4人で（計7チーム28名）のランダムな座席表を作りたいです。

http://oshiete1.goo.ne.jp/qa3376116.html
を参考に作ったのですが、うまく機能しません。
各チーム代表者1名は固定して、残り21名を同じチームで対戦しないでなおかつランダムな振り分けをしたいです。

どなたか知恵を貸して戴けないでしょうか？

No.1 回答者： n-jun 回答日時： 2008/12/29 06:02

＞を参考に作ったのですが、うまく機能しません。

どの回答を参考に、どのようにしてもうまくいかなかったのか、それを提示されては？

どこに何があって、どこにどのように表示したいなども欠如してますし。

No.2 回答者： hige_082 回答日時： 2008/12/29 08:00

関数？マクロ？

＞を参考に作ったのですが、うまく機能しません。
回答もそうですが、質問が曖昧だと回答が付きにくいよ
参考になさったリンク先の＃５さんの回答を特に前提の所をよく読んでみてください

どこに座席表を作りたいの？
どこに参加者？２８名の表があるの？
代表者の見分け方は？２８名の表に含まれているの？別表になっているの？

上記の理由で何を回答していいのか分かりませんが
シート１のセルＡ１から下方向に２８名分の名前をランダムに並び替えるマクロだけ提示しておきます
’--------------------------------------------------------
Sub Macro1()
Dim idx, R, C As Integer
Randomize
For idx = 1 To 28
Sheets("Sheet1").Cells(idx, 2) = Rnd
Next idx
With Sheets("sheet1")
.Activate
.Cells(1, 1).CurrentRegion.Select
Selection.Sort key1:=Range("b1"), 　　　　Order1:=xlAscending, header:=xlGuess
.Columns(2).ClearContents
End With
End Sub
’--------------------------------------------------------
リンク先の＃５さんのマクロをアレンジしました
回答にはなっていないと思いますが
参考までに

参考URL：http://oshiete1.goo.ne.jp/qa3376116.html

この回答への補足

回答ありがとうございます。
補足でシート１に座席表、シート３に名簿と点数表を作っています。
シート１（A列に各卓、B列代表者名前、CDE列に参加者名前）
シート3（A列に代表者を除いたNo.1～18,B列にチームA,A,A、B,B,B～G,G,Gまで　C列に名前）です。
シート３の名簿に名前を記入するとチーム員同士被らないで自動で振り分けが出来るようにしたいです。

補足日時：2008/12/29 11:03

No.3 回答者： web2525 回答日時： 2008/12/29 10:13

試合を何試合するのかは解りませんが、なぜ乱数表でランダムに作る必要があるのですか?

各グループをA～GとしメンバーをそれぞれA1～A4とあらわした表を作り、2行目から4行目をそれぞれ1行ずらした表を作成すれば7パターンのの対戦表は作成されます。
それで試合数が足らなければ各チームの番号を同様に1列ずらしていけば違う対戦カードが組めます。

この回答への補足

回答ありがとうございます。
確かに乱数で作る必要はないのですが、公平せいを出したいのと上記の場合4回戦したときにG4の人がA1と対戦する可能性がないと思うので・・・
でもかなり参考になりました。ありがとうです。

補足日時：2008/12/29 11:57

No.4 ベストアンサー 回答者： hige_082 回答日時： 2009/01/02 09:48

＃２です

補足を踏まえてアレンジ
’--------------------------------------------------------
Sub Macro1()
Dim idx, R As Integer
Dim a, aa As Variant
aa = Split("A B C D E F G")
Randomize
For idx = 1 To 21
Sheets("Sheet3").Cells(idx, 4) = Rnd
Next idx
With Sheets("sheet3")
.Activate
.Cells(1, 1).CurrentRegion.Select
Selection.Sort key1:=Range("d1"), Order1:=xlAscending, header:=xlGuess
.Columns(2).ClearContents
.Columns(4).ClearContents
End With
R = 1
For Each a In aa
For idx = 1 To 3
Sheets("Sheet3").Cells(R, 2) = a
R = R + 1
Next idx
Next a
End Sub
’--------------------------------------------------------

参考まで

この回答へのお礼

有難う御座いました。
又、お礼が遅くなり申し訳ないです。

お礼日時：2009/01/19 09:27