[[20160921134218]]　『関数の質問です！』（ｋａｋａｓｉ）　ページの最後に飛ぶ

『関数の質問です！』（ｋａｋａｓｉ）

ソフトボールの試合の組み方。12チームが常に巴戦で各チーム3回総当たり戦の票を作成したいのですが、今年になって約半年まだできません、関数ってどれを使えばいいのか教えてください。

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

 ＞12チームが常に巴戦で各チーム3回総当たり戦の票

 具体的イメージが掴めないのですが、

 「常に巴戦」と言うのが分かっていないセイかも知れません。

 4チームずつに分かれてその中で総当たりし、
 それが終わったら、また未対戦のチームが4チーム集まって総当たりし、
 ・・・とかして、全チームが1回必ず対戦する、という方式ですか？

（半平太） 2016/09/21(水) 14:21

関数ではなく、アイデアですよ。
12チームと考えず、4チームの巴戦を考えてください。これを3組作れば良いかと。

1日目 AB、CD
2日目 AC、BD
3日目 AD、BC
（???） 2016/09/21(水) 14:42

半平太さん、コメントありがとうございます♪
詳しく書きますね、12チームに記号を付けてＡ～Ｌまで、常に3チームが一つのブロックになって試合をします。
一つのグランドにＡチーム、Ｂチーム、Ｃチームとあつまり、第一試合がＡとＢ．Ｃチームが審判
第二試合がＡとＣでＢチームが審判。第三試合がＢとＣでＡチームが審判で一日3試合。
それを別のグランドではＤ・Ｅ・Ｆのチームが同じように試合を、また別のグランドＧ・Ｈ・Ｉのチームが。またＪ・Ｋ・Ｌと試合をして、次の組み合わせはＡとＤとＧとか。Ａ・Ｈ・Ｌとか常に3チームが集まって試合をして各チームが年間3試合の総当たり戦を組みたいのです。
この説明でわかりますか～！
（ｋａｋａｓｉ） 2016/09/21(水) 15:36

 よーわからんけど。こういうこと？

	A	B	C	D	E	F	G	H	I	J
1		1			2			3		
2		対戦1	対戦2	審判	対戦1	対戦2	審判	対戦1	対戦2	審判
3	1	A	B	C	B	C	A	C	A	B
4	1	D	E	F	E	F	D	F	D	E
5	1	G	H	I	H	I	G	I	G	H
6	1	J	K	L	K	L	J	L	J	K
7	2	B	C	D	C	D	B	D	B	C
8	2	E	F	G	F	G	E	G	E	F
9	2	H	I	J	I	J	H	J	H	I
10	2	K	L	A	L	A	K	A	K	L
11	3	C	D	E	D	E	C	E	C	D
12	3	F	G	H	G	H	F	H	F	G
13	3	I	J	K	J	K	I	K	I	J
14	3	L	A	B	A	B	L	B	L	A
15	4	D	E	F	E	F	D	F	D	E
16	4	G	H	I	H	I	G	I	G	H
17	4	J	K	L	K	L	J	L	J	K
18	4	A	B	C	B	C	A	C	A	B
19	5	E	F	G	F	G	E	G	E	F
20	5	H	I	J	I	J	H	J	H	I
21	5	K	L	A	L	A	K	A	K	L
22	5	B	C	D	C	D	B	D	B	C
23	6	F	G	H	G	H	F	H	F	G
24	6	I	J	K	J	K	I	K	I	J
25	6	L	A	B	A	B	L	B	L	A
26	6	C	D	E	D	E	C	E	C	D
27	7	G	H	I	H	I	G	I	G	H
28	7	J	K	L	K	L	J	L	J	K
29	7	A	B	C	B	C	A	C	A	B
30	7	D	E	F	E	F	D	F	D	E
31	8	H	I	J	I	J	H	J	H	I
32	8	K	L	A	L	A	K	A	K	L
33	8	B	C	D	C	D	B	D	B	C
34	8	E	F	G	F	G	E	G	E	F
35	9	I	J	K	J	K	I	K	I	J
36	9	L	A	B	A	B	L	B	L	A
37	9	C	D	E	D	E	C	E	C	D
38	9	F	G	H	G	H	F	H	F	G
39	10	J	K	L	K	L	J	L	J	K
40	10	A	B	C	B	C	A	C	A	B
41	10	D	E	F	E	F	D	F	D	E
42	10	G	H	I	H	I	G	I	G	H
43	11	K	L	A	L	A	K	A	K	L
44	11	B	C	D	C	D	B	D	B	C
45	11	E	F	G	F	G	E	G	E	F
46	11	H	I	J	I	J	H	J	H	I
47	12	L	A	B	A	B	L	B	L	A
48	12	C	D	E	D	E	C	E	C	D
49	12	F	G	H	G	H	F	H	F	G
50	12	I	J	K	J	K	I	K	I	J

 A3:A6 に 1を入力。
 A7 =A3+1

 B3 =MID("ABCDEFGHIJKLABCDEFGHIJKL",MOD(ROW(A1)-1,4)*3+COLUMN(A1)+$A3-1,1)
 D3までコピー。

 E3 =C3
 F3 =D3
 G3 =B3

 E3:G3をH3:J3にコピー。

 B3:J3をB7:J7までコピー。

 A7:J7を下へコピー。
　
（GobGob） 2016/09/21(水) 17:11

gobgobさん、ありがとうございます、＝ＭＩＤの使い方、ちょっとむつかしいけど、これからやってみます。
上記に書き込んでくれてあるやり方では。一番左側の「７」のとこでＢ・Ｃ・ＤではすでにＢとＣは3回の対戦がおわってます、この「７」を参入すると計6回当たることになります。
ＡとＢ．ＡからＬまですべて3回戦にしたいのです。
今までにいろんな文字を並べてみました、ＡとＨとＪとか、。常に巴戦ですから難しいです。
（ｋａｋａｓｉ） 2016/09/22(木) 15:45

前の回答は無視されたので、もう放置しようかと思ったのですが、話が進まないようなので、マクロ案を書きます。

関数では無理な組合せ数であり、更には無駄なくきっちり3回ずつという最適化は、不可能に思います。
マクロを使っても、総当たりでチェックするにしては組合せ数が膨大なため、ランダムな組合せを作成する、というのはいかがでしょうか。

test1は、ランダムで組合せを作成するマクロ。
test2は、どことどこが何回当たったか数えるマクロ。
test3は、test1とtest2を使ってランダム対戦表を作成。これが指定した回数に収まっているか判定するマクロです。

1日の組合せを、「ABC」のように表現します。この中の巴戦部分は、書かなくても判るかと思います。
ロジック制限として、12チーム固定。試合数と最小対戦回数、最大対戦回数はConst値で変更可能。試行回数もConst値で変更可能です。 30日で、同じ相手と3～10回当たる場合の例になっています。

 Sub test1()
    Const SU = 30
    Dim cDim(11) As String
    Dim cw As String
    Dim iw As Long
    Dim i As Long
    Dim j As Long

    Randomize
    Columns("A:D").ClearContents

    For i = 1 To SU
        For j = 0 To 11
            cDim(j) = Chr(65 + j)
        Next j
        For j = 0 To 11
            iw = Int(Rnd() * 12)
            cw = cDim(iw)
            cDim(iw) = cDim(j)
            cDim(j) = cw
        Next j
        For j = 0 To 3
            Cells(i, j + 1).Value = cDim(j * 3) & cDim(j * 3 + 1) & cDim(j * 3 + 2)
        Next j
    Next i
 End Sub

 Sub test2()
    Dim i As Long
    Dim j As Long
    Dim k As Long
    Dim L As Long
    Dim iw(2) As Long

    Range("G2:R13").ClearContents
    Range("G1").Resize(1, 12).Value = Array("A", "B", "C", "D", "E", "F", "G", "H", "I", "J", "K", "L")
    Range("G1").Resize(1, 12).Copy
    Range("F2").PasteSpecial xlPasteValues, , , True
    Application.CutCopyMode = False

    For i = 1 To Cells(Rows.Count, "A").End(xlUp).Row
        For j = 1 To 4
            For k = 1 To 3
                iw(k - 1) = Asc(Mid(Cells(i, j).Value, k, 1)) - 65
            Next k
            For k = 0 To 2
                For L = k + 1 To 2
                    If iw(k) < iw(L) Then
                        Range("G2").Offset(iw(k), iw(L)) = Range("G2").Offset(iw(k), iw(L)) + 1
                    Else
                        Range("G2").Offset(iw(L), iw(k)) = Range("G2").Offset(iw(L), iw(k)) + 1
                    End If
                Next L
            Next k
        Next j
    Next i
 End Sub

 Sub test3()
    Const iTRY = 999
    Const iMIN = 3
    Const iMAX = 10
    Dim i As Long
    Dim iw1 As Long
    Dim iw2 As Long

    Application.ScreenUpdating = False

    For i = 0 To iTRY
        Call test1
        Call test2

        If Application.WorksheetFunction.CountA(Range("H2:R13")) = 66 Then
            iw1 = Application.WorksheetFunction.Min(Range("H2:R13"))
            iw2 = Application.WorksheetFunction.Max(Range("H2:R13"))
            If iMIN <= iw1 And iw2 <= iMAX Then
                Exit For
            End If
        End If
    Next i

    Application.ScreenUpdating = True

    If iTRY < i Then
        MsgBox "見つかりませんでした。", vbExclamation, "×"
    Else
        MsgBox i + 1 & "回目で見つかりました。", vbExclamation, "○"
    End If
 End Sub
（???） 2016/09/23(金) 14:15

ちなみに、GobGobさん案だと、隣り合った（または1つ飛び）相手としか当たらないので、思いっきり偏りが出ます。以下のデータで test2 を動かしてみると判るかと思います。

ABC DEF GHI JKL
BCD EFG HIJ KLA
CDE FGH IJK LAB
DEF GHI JKL ABC
EFG HIJ KLA BCD
FGH IJK LAB CDE
GHI JKL ABC DEF
HIJ KLA BCD EFG
IJK LAB CDE FGH
JKL ABC DEF GHI
KLA BCD EFG HIJ
LAB CDE FGH IJK
（???） 2016/09/23(金) 14:36

 やっぱり理解できてまへんでしたｗ。
　
（GobGob） 2016/09/23(金) 16:07

コメント返信：

[ 一覧(最新更新順) ]

[[20160921134218]] 『関数の質問です！』（ｋａｋａｓｉ） ページの最後に飛ぶ

[[20160921134218]]　『関数の質問です！』（ｋａｋａｓｉ）　ページの最後に飛ぶ