[[20150902105730]]　『エクセルで毎日違う席順作成したい』（メジロ）　ページの最後に飛ぶ

『エクセルで毎日違う席順作成したい』（メジロ）

[[20150330215418]]　『エクセルにて毎日変わる席順表を作りたい』（のい）

この質問の回答にあったＶＢＡコードの人数を変更してチャレンジしてみましたが、条件が違うためうまくできません。

Sub Seating()

    Dim seatingMaster(1 To 17, 1 To 2)
    Dim seatingTable(1 To 17, 1 To 2)
    Dim objSL
    Set objSL = CreateObject("System.Collections.SortedList")

 '// Initialize
    Randomize

    Range("A1").Resize(1, 100).EntireColumn.ColumnWidth = 3
    Range("A1").Resize(40, 100).ClearContents

    Dim r As Long
    For r = 1 To 17
        seatingMaster(r, 1) = r
        seatingMaster(r, 2) = 35 - r
    Next

    Dim c As Long

    For c = 0 To 32
 '// Shuffle
        objSL.Clear   '// 修正
        For r = 1 To 17
            If Rnd() > 0.5 Then
                objSL.Add Rnd(), seatingMaster(r, 1) & vbTab & seatingMaster(r, 2)
            Else
                objSL.Add Rnd(), seatingMaster(r, 2) & vbTab & seatingMaster(r, 1)
            End If
        Next

 '// Preparation
        For r = 1 To 17
            seatingTable(r, 1) = Split(objSL.getByIndex(r - 1), vbTab)(0)
            seatingTable(r, 2) = Split(objSL.getByIndex(r - 1), vbTab)(1)
        Next

 '// Output
        Range("A1").Offset(0, c * 3).Value = "M【" & c + 1 & "】"   'Master List
        Range("A2").Offset(0, c * 3).Resize(17, 2) = seatingMaster
        Range("A20").Offset(0, c * 3).Value = "S【" & c + 1 & "】"  'Shuffle List
        Range("A21").Offset(0, c * 3).Resize(17, 2) = seatingTable

 '// Rotation
        Dim rightTop As Long
        Dim leftBottom As Long

        rightTop = seatingMaster(1, 2)
        leftBottom = seatingMaster(17, 1)

        For r = 1 To 16
            seatingMaster(18 - r, 1) = seatingMaster(17 - r, 1)
            seatingMaster(r, 2) = seatingMaster(r + 1, 2)
        Next
        seatingMaster(17, 2) = leftBottom
        seatingMaster(2, 1) = rightTop
    Next
 End Sub

ＶＢＡは上記です。

条件は、
1　人数は25人
2　20人で10ﾍﾟｱ・5人はバラ
3　5人は毎週同じ人（月～金）
4　10ペアは1ヶ月同じペアにならない（20日）
5　席は、2日連続で同じ席にならない

ＶＢＡでペア作成までは出来たのですが、5人は毎週同じメンバ、というところで躓いております。（5人チームは毎週同じですがメンバは曜日で違います。1週間で全員でループします）
5は自分で席を決定するにしても、5人チームはメンバ固定、なおかつ20人は毎日違うペア、というところが自分の頭では考えきれず悩み倒しました。
どなたかご教授して頂ければ、と思います。

よろしくお願いします。

＜使用 Excel：Excel2007、使用 OS：WindowsXP ＞

基本的な解き方だけ。

5人のチームを5組作る
5チームからふたつのペアチームを作る。残ったチームがバラ係
ペアチームになったチームの相手5人と、5日間でローテでペアになる
チームの組み合わせを変えて4.5週分繰り返す

あとはできたデータを好きにランダムで入れ替えればいい
バラ係は週固定か曜日固定かどちらにも取れるが、まぁ行列が変わるだけでそんなに変わらない。

（日捲り熊五郎） 2015/09/02(水) 18:42

日捲り熊五郎さん！ありがとうございます！
解き方提示して頂いただけでもすごく参考になりました！！

（メジロ） 2015/09/04(金) 10:19

こういうのって、方程式のようなものは存在しないんでしょうか・・？
もし人数が変わった場合も、人数を入力したら座席表が作れるようなＥＸＣＥＬを作成したいと思っています。

（メジロ） 2015/09/04(金) 17:27

コメント返信：

[ 一覧(最新更新順) ]

[[20150902105730]] 『エクセルで毎日違う席順作成したい』（メジロ） ページの最後に飛ぶ

[[20150902105730]]　『エクセルで毎日違う席順作成したい』（メジロ）　ページの最後に飛ぶ