[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『エクセルで毎日違う席順作成したい』(メジロ)
[[20150330215418]] 『エクセルにて毎日変わる席順表を作りたい』(のい)
この質問の回答にあったVBAコードの人数を変更してチャレンジしてみましたが、条件が違うためうまくできません。
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
VBAは上記です。
条件は、
1 人数は25人
2 20人で10ペア・5人はバラ
3 5人は毎週同じ人(月〜金)
4 10ペアは1ヶ月同じペアにならない(20日)
5 席は、2日連続で同じ席にならない
VBAでペア作成までは出来たのですが、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
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.