[[20150125144047]]　『ＧＯＬＦの組み合わせ（16人）』（ＴＡＫ。）　ページの最後に飛ぶ

『ＧＯＬＦの組み合わせ（16人）』（ＴＡＫ。）

仲間16人(4人一組で4組）で毎週ゴルフを楽しんでいます。
すべての人が、できるだけ最少回数で残り13人とｐｌａｙできる
組み合わせの方法を求めたいのですが、どのような関数を使って
求めたらよいのか教えてください。よろしくお願いいたします。

＜使用 Excel：Excel2010、使用 OS：Windows7 ＞

 回答じゃあないんですが
 16人もいればうまい下手、性格が合う・合わない、気がきく・利かない
 とかいろいろ考えなければならないと思います。

 私も一度ランダムに組み合わせを作ってやったことがありました。

 カートが置いてけぼりになった組や
 ピンをささずに次のコースに向かった組や
 シングル一人、ハンデ30初心者3人で進行が遅くなった組など
 飲み会で愚痴を言われたりと散々でした。

 ググってみましたが、アプリ等もそれらしいものがない＝需要がないってことではないでしょうか？

 ちなみに自分含めると残り12人とプレーできる（16－自分－メンバー3人＝12）ってことですよね？

（稲葉） 2015/01/26(月) 10:23

式にするまでもなく、一人ずつずらしていく例。

	1日目	2日目	3日目	4日目	5日目
1	A	A	A	A	A
2	A	B	B	B	B
3	A	C	C	C	C
4	A	D	D	D	D
5	B	A	D	C	B
6	B	B	A	D	C
7	B	C	B	A	D
8	B	D	C	B	A
9	C	A	D	C	B
10	C	B	A	D	C
11	C	C	B	A	D
12	C	D	C	B	A
13	D	A	D	C	B
14	D	B	A	D	C
15	D	C	B	A	D
16	D	D	C	B	A

しかしながら、稲葉さんの懸念同様、スコア差のありすぎる人は組まないほうが円滑に進むと思いますね。
（???） 2015/01/26(月) 10:32

同じく、ずらしていく方法です。

1日目 A B C D ・ E F G H ・ I J K L ・ＭＮＯＰ
2日目ＡＥＩＭ・ B ＦＪＮ・ C ＧＫＯ・ D H L P
3日目 A F K P ・ B E L O ・ C H I N ・ D G J M
4日目 A G L N ・ B H K M ・ C E J P ・ D F I O
5日目 A H J O ・ B G I P ・ C F L M ・ D E K N

（Ｇ999） 2015/01/26(月) 13:59

稲葉さん、G999さん早速回答ありがとうございました。
困るとすぐに式で何とかというのは
EXCEL狂の欠陥ですかね？(笑い）
回答拝見して「目から鱗」でした。

ありがとういございました。

ＴＡＫ
（ＴＡＫ。） 2015/01/26(月) 15:01

 まあ毎回組み合わせ決めるの大変ですけどね。
 ちなみにランダムで決めたときのコードが見つかったので参考に載せておきます。
 ロジックは適当です・・・

 C3から名前を載せていって、最大100行目までです。
 実行するとパラメーターの入力が促されますので、入力してください。
 E列に結果が出力されます。

    Sub ランダム組合せ()
        Dim tbl As Variant, res As Variant
        Dim x As Long, y As Long, z As Long, i As Long, j As Long, k As Long, l As Long, n As Long
        Dim m As Variant

        tbl = Application.Transpose(Range(Range("C3"), Range("C100").End(xlUp)).Value)
        x = CInt(InputBox("１組当たりの人数を入力してください。", "人数入力", 4))
        y = CInt(InputBox("組数を入力してください。", "組数入力", 3))
        Randomize
        Range("E1:O1000").ClearContents
        For z = 1 To InputBox("何回試行しますか？", "試行回数", 1)
            i = 1
            k = 1
            l = 1
            Randomize
            With CreateObject("Scripting.Dictionary")
                For Each m In tbl
                    If m <> "" Then
                        .Add i, m
                        i = i + 1
                    End If
                Next m
                Do Until .Count = x * y
                    .Add i, ""
                    i = i + 1
                Loop
                ReDim res(1 To x, 1 To y)
                Do Until .Count = 0
                    j = Int((x * y) * Rnd + 1)
                    If .exists(j) Then
                        res(k, l) = .Item(j)
                        .Remove (j)
                        l = IIf(l = y, 1, l + 1)
                        k = IIf(l = 1, k + 1, k)
                    End If
                Loop
            End With
            With Range("E1000").End(xlUp).Offset(2)
                For n = 0 To y - 1
                    .Offset(, n) = n + 1 & "組目"
                Next n
                .Offset(1).Resize(UBound(res, 1), UBound(res, 2)) = res
            End With
        Next z
    End Sub
（稲葉） 2015/01/26(月) 15:14

コメント返信：

[ 一覧(最新更新順) ]

[[20150125144047]] 『ＧＯＬＦの組み合わせ（16人）』（ＴＡＫ。） ページの最後に飛ぶ

[[20150125144047]]　『ＧＯＬＦの組み合わせ（16人）』（ＴＡＫ。）　ページの最後に飛ぶ