[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『ランダムに抽出』（前）
お世話になります。
シフト表(2019年1月のもの。実際の人数は20人です。)
回数 1 2 1 1 1 1 1 2 回数 日付 1 2 3 4 5 6 7 8 9 10...31 曜日 火 水 木 金 土 日 月 火 水 木 木 あ a b 休 a b 休 休 a b 日 a 1 い 休 休 a b 休 a b 休 a b 休 1 う b 休 a 休 日 日 a 休 b 休 b 3
抽出結果
氏名 日付 あ 1/10 い 1/5 う 1/2 1/4 1/8
(1) 一行目の回数の数字に応じてその日の"休"または"日"の人をランダムに抽出したい。 (2) 一人辺りの一ヶ月の抽出は右端の回数だけ行う。 (3) "休"が連続するときはその人は抽出しない。（"日"は連続しても抽出対象） (4) 抽出結果は複数パターン表示したい。
しばらくずっと考えているのですが、とっかかりすら得られず。 よろしくお願いします。
＜ 使用 Excel：Excel2010、使用 OS：Windows7 ＞
回答ではありません。 m(__)m 単に疑問点の確認だけ・・・
どんな目的に使うんですか？ イメージが涌かないんですけど・・
＞ "休"が連続するときはその人は抽出しない。
シフト表で「休」が連続した場合ですね？ その場合、連続開始日(=先頭）の「休」も対象外ってことですか？
＞抽出結果は複数パターン表示したい。 こう言う仕様って、キリがない気がするんですが、どう言う趣旨なんですか？ 全パターン表示？ 100パターンあったら一割くらい(10パターン）表示？ 2パターン以上あっても、２パターン表示でいい？
（半平太） 2019/01/02(水) 15:56
ありがとうございます。
>どんな目的に使うんですか？
仕事に関することで説明が難しいです。休みの人を指定する必要があるとだけ。今まで手作業でやっていたのを自動でランダムに振り分けて、そこから都合の悪い人だけを変更するといった形で使用したいと思っています。
>その場合、連続開始日(=先頭）の「休」も対象外ってことですか？
そうです。
>こう言う仕様って、キリがない気がするんですが、どう言う趣旨なんですか？
乱数で調べるて見ると、RANDBETWEEN関数というものがありました。これのように、再計算ごとに変化するという使い方が出来ればと考えていました。 もしかしたら根本的に勘違いしているかもしれません。 前述のとおり振り分けた結果から人の手で仕分けしようと思ってますので、パターンはなくても問題ないかもしれません。
分かりにくくてすみません。 （前） 2019/01/02(水) 16:22
機械的に出来るかも、と思っていたのですが、結構厄介ですねぇ・・
月の初めの方で、適当に(機械的に）割り振って行くと、 後の方の日で、その日はノルマ達成した人しか残ってないなんて事態が発生する可能性があります。
そうなると、その日はまだノルマ達成していないようにすべく、 月初の方で割り当てたのを取り消し、他の人に割り当てる、なんて後追い操作が必要になります。
そもそも、日別回数合計 と 人別回数合計 ってどんな関係にあるんでしょうか？
日別回数合計 ＞ 人別回数合計
だったら、絶対に無理ですよね？
（ 半平太） 2019/01/02(水) 23:01
おはようございます。
>そもそも、日別回数合計 と 人別回数合計 ってどんな関係にあるんでしょうか？ >日別回数合計 ＞ 人別回数合計 >だったら、絶対に無理ですよね
日別合計回数（使わせていただきます）は毎月29回と決まってます。なので必ず複数回割り当てられる人が出ます。
よろしくお願いします。（といってもエクセルの通常機能で難しいのであれば、また別の手段を考てみます） （前） 2019/01/03(木) 06:21
日別合計回数が毎月29回は分かりましたが、全貌が依然としてハッキリしません。
１．29回の内訳をどの日に割り振るのか、また、誰に何回やらせるかは、どう決まるんですか？
※ それらの数字が先に決まるんですよね？
↑
これ大事なんですけど。なんか「結果集計」なのかな、との疑念も生じているんですが・・
つまり、個人別は、2回を超えないように適当に割り振ればいいだけなのかも知れないなぁ・・と。
２．こういう関係にはならないことがハッキリしているのかも知りたいんですが？（結果集計なら等しくなるので、そんな事態になる筈もないですが） ↓ 「日別合計回数（多い） ＞ 人別合計回数（少ない）」
（ 半平太） 2019/01/03(木) 07:51
>１．29回の内訳をどの日に割り振るのか、また、誰に何回やらせるかは、どう決まるんですか？
29回の内訳は日付は固定です。（変わる可能性もあるので最初の表は適当です。実際は1日と30日、31日を除く日で28日だけ2人指定します）
シフト表ができてから、この人に何回振り分ける、というように決めてます。ある程度は決まってますが、その月いない人もいるので、その場合は別の人がもらいます。
>「日別合計回数（多い） ＞ 人別合計回数（少ない）」
必ず等しいです。割り振られている日は必ず人を指定しなければならないので、 「日別合計回数=人別合計回数」となります。 （前） 2019/01/03(木) 08:48
（γ） 2019/01/03(木) 10:11
お待たせしました。割り振りがないのは30日じゃなく21日でした。
1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 2 1 1
1 2 3 4 5 6 7 8 9 10 11 12 13 1415 16 1718 19 2021 22 2324 25 2627 28 293031
火 水 木 金 土 日 月 火 水 木 金 土 日 月 火 水 木 金 土 日 月 火 水 木 金 土 日 月 火 水木
あ休 休 休 休 休 休 休 休 休 休 休
い 休 休 休 休 休 休 休 休 休
お 休 休 休 休 休 休 休 休 休
か 休 休 休 休 休 休 休
き 休 休 休 休 休 休 休 休
く休 休 休 休 休 休 休 休 休 休 休
日 1 2 3 4 5 6 7 8 9 10 11 12 13 1415 16 1718 19 2021 22 2324 25 2627 28 293031
け 休 休 休 休 休 休 休 休
こ 休 休 休 休 休 休 休 休 休 休
さ 休 日休 休 日
し休 休 休 休 休 日 休 休
す 休 休 休 休 休 休 休 休 休
せ 休 休 休 休 休 休 休
そ 休 休 休 休 休 日 休 休
日 1 2 3 4 5 6 7 8 9 10 11 12 13 1415 16 1718 19 2021 22 2324 25 2627 28 293031
た 休 休 休 休 休 休 休 休 休 休
ち 休 休 休 休 休 休 休 休
つ休 休 休 休 休 休 休 休
て 休 休 休 休 休 休 休 休 休
と 休 休 休 休 休休 日 日 休 休 休 休
な 休 休 休日 日 日
人回数 日付 く ２ 16,28 け 2 19,28 さ １ 4 し ２ 10,13 す ２ 8,17 せ ２ 20,29 そ ３ 3,9,30 た ２ 15,27 ち ４ 6,12,18,24 つ ３ 7,22,24 て ３ 2,11,26 と ２ 5,23 な １ 14 （前） 2019/01/03(木) 11:29
（γ） 2019/01/03(木) 11:50
休と日の日付データだけでも良いですか？ひらがなめちゃくちゃだったのでアルファベットにします。
a 休 1、4、7、10、13、16、19、22、25、28、31 b 休 5、6、9、12、15、18、21、26、29 c 休 3、12、13、14、18、21、24、27、30 d 休 2、5、8、11、14、26、29 e 休 2、5、8、11、14、17、20、23 f 休 1、4、7、10、13、16、19、22、25、28、31 g 休 6、12、16、19、22、25、28、31 h 休 2、5、8、11、14、17、20、23、26、29 i 休 3、5、6 日 4 j 休 1、4、7、11、27、30 日 16 k 休 2、5、8、11、14、17、20、23、26 l 休 2、5、14、20、23、26、29 m 休 3、6、9、12、15、27、30 日 16 n 休 3、6、9、12、15、18、21、24、27、30 o 休 3、6、9、12、15、18、21、24 p 休 1、4、7、19、22、25、28、31 q 休 2、5、8、11、14、17、20、23、26 r 休 2、5、8、11、14、17、20、23、26、29 s 休 14、17、20 日 21、22、23 （前） 2019/01/03(木) 13:06
_____ ____ ____ ____ ____ ____ ____ ____ ____ ____ ____ ____ ____ ____ ____ ____ ____ ____ ____ ____ ____ ____ ____ ____ ____ ____ ____ ____ ____ ____ ____ ____ ____ |_____|__A_|__B_|__C_|__D_|__E_|__F_|__G_|__H_|__I_|__J_|__K_|__L_|__M_|__N_|__O_|__P_|__Q_|__R_|__S_|__T_|__U_|__V_|__W_|__X_|__Y_|__Z_|_AA_|_AB_|_AC_|_AD_|_AE_|_AF_| |___1_| |___2_| 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 |___3_| 火 水 木 金 土 日 月 火 水 木 金 土 日 月 火 水 木 金 土 日 月 火 水 木 金 土 日 月 火 水 木 |___4_| a 休 休 休 休 休 休 休 休 休 休 休 |___5_| b 休 休 休 休 休 休 休 休 休 |___6_| c 休 休 休 休 休 休 休 休 休 |___7_| d 休 休 休 休 休 休 休 |___8_| e 休 休 休 休 休 休 休 休 |___9_| f 休 休 休 休 休 休 休 休 休 休 休 |__10_| g 休 休 休 休 休 休 休 休 |__11_| h 休 休 休 休 休 休 休 休 休 休 |__12_| i 休 日 休 休 |__13_| j 休 休 休 休 日 休 休 |__14_| k 休 休 休 休 休 休 休 休 休 |__15_| l 休 休 休 休 休 休 休 |__16_| m 休 休 休 休 休 日 休 休 |__17_| n 休 休 休 休 休 休 休 休 休 休 |__18_| o 休 休 休 休 休 休 休 休 |__19_| p 休 休 休 休 休 休 休 休 |__20_| q 休 休 休 休 休 休 休 休 休 |__21_| r 休 休 休 休 休 休 休 休 休 休 |__22_| s 休 休 休 日 日 日
（チオチモリン） 2019/01/03(木) 14:16
┌─┬─┬─┬─┬─┬─┬─┬─┬─┬─┬─┬─┬─┬─┬─┬─┬─┬─┬─┬─┬─┬─┬─┬─┬─┬─┬─┬─┬─┬─┬─┬─┐ │ │ 1│ 2│ 3│ 4│ 5│ 6│ 7│ 8│ 9│10│11│12│13│14│15│16│17│18│19│20│21│22│23│24│25│26│27│28│29│30│31│ ├─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┤ │ │火│水│木│金│土│日│月│火│水│木│金│土│日│月│火│水│木│金│土│日│月│火│水│木│金│土│日│月│火│水│木│ ├─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┤ │a │休│ │ │休│ │ │休│ │ │休│ │ │休│ │ │休│ │ │休│ │ │休│ │ │休│ │ │休│ │ │休│ ├─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┤ │b │ │ │ │ │休│休│ │ │休│ │ │休│ │ │休│ │ │休│ │ │休│ │ │ │ │休│ │ │休│ │ │ ├─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┤ │c │ │ │休│ │ │ │ │ │ │ │ │休│休│休│ │ │ │休│ │ │休│ │ │休│ │ │休│ │ │休│ │ ├─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┤ │d │ │休│ │ │休│ │ │休│ │ │休│ │ │休│ │ │ │ │ │ │ │ │ │ │ │休│ │ │休│ │ │ ├─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┤ │e │ │休│ │ │休│ │ │休│ │ │休│ │ │休│ │ │休│ │ │休│ │ │休│ │ │ │ │ │ │ │ │ ├─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┤ │f │休│ │ │休│ │ │休│ │ │休│ │ │休│ │ │休│ │ │休│ │ │休│ │ │休│ │ │休│ │ │休│ ├─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┤ │g │ │ │ │ │ │休│ │ │ │ │ │休│ │ │ │休│ │ │休│ │ │休│ │ │休│ │ │休│ │ │休│ ├─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┤ │h │ │休│ │ │休│ │ │休│ │ │休│ │ │休│ │ │休│ │ │休│ │ │休│ │ │休│ │ │休│ │ │ ├─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┤ │i │ │ │休│日│休│休│ │ │ │ │ │ │ │ │ │ │ │ │ │ │ │ │ │ │ │ │ │ │ │ │ │ ├─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┤ │j │休│ │ │休│ │ │休│ │ │ │休│ │ │ │ │日│ │ │ │ │ │ │ │ │ │ │休│ │ │休│ │ ├─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┤ │k │ │休│ │ │休│ │ │休│ │ │休│ │ │休│ │ │休│ │ │休│ │ │休│ │ │休│ │ │ │ │ │ ├─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┤ │l │ │休│ │ │休│ │ │ │ │ │ │ │ │休│ │ │ │ │ │休│ │ │休│ │ │休│ │ │休│ │ │ ├─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┤ │m │ │ │休│ │ │休│ │ │休│ │ │休│ │ │休│日│ │ │ │ │ │ │ │ │ │ │休│ │ │休│ │ ├─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┤ │n │ │ │休│ │ │休│ │ │休│ │ │休│ │ │休│ │ │休│ │ │休│ │ │休│ │ │休│ │ │休│ │ ├─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┤ │o │ │ │休│ │ │休│ │ │休│ │ │休│ │ │休│ │ │休│ │ │休│ │ │休│ │ │ │ │ │ │ │ ├─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┤ │p │休│ │ │休│ │ │休│ │ │ │ │ │ │ │ │ │ │ │休│ │ │休│ │ │休│ │ │休│ │ │休│ ├─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┤ │q │ │休│ │ │休│ │ │休│ │ │休│ │ │休│ │ │休│ │ │休│ │ │休│ │ │休│ │ │ │ │ │ ├─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┤ │r │ │休│ │ │休│ │ │休│ │ │休│ │ │休│ │ │休│ │ │休│ │ │休│ │ │休│ │ │休│ │ │ ├─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┤ │s │ │ │ │ │ │ │ │ │ │ │ │ │ │休│ │ │休│ │ │休│日│日│日│ │ │ │ │ │ │ │ │ └─┴─┴─┴─┴─┴─┴─┴─┴─┴─┴─┴─┴─┴─┴─┴─┴─┴─┴─┴─┴─┴─┴─┴─┴─┴─┴─┴─┴─┴─┴─┴─┘
（チオチモリン） 2019/01/03(木) 14:26
チオチモリンさんありがとうございます。
>日別回数合計と人別回数合計は、理解できませんでした。
1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 2 1 1 =29
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31
人回数 日付 f ２ 16,28 g 2 19,28 i １ 4 j ２ 10,13 k ２ 8,17 l ２ 20,29 m ３ 3,9,30 n ２ 15,27 o ４ 6,12,18,24 p ３ 7,22,24 q ３ 2,11,26 r ２ 5,23 s １ 14 =29
こういうことなのですが、最初の説明を間違えてたらすみません……。 （前） 2019/01/03(木) 14:48
(1) 一行目の回数の数字に応じてその日の"休"または"日"の人をランダムに抽出したい。 (2) 一人辺りの一ヶ月の抽出は右端の回数だけ行う。 (3) "休"が連続するときはその人は抽出しない。（"日"は連続しても抽出対象）
┌─┬─┬─┬─┬─┬─┬─┬─┬─┬─┬─┬─┬─┬─┬─┬─┬─┬─┬─┬─┬─┬─┬─┬─┬─┬─┬─┬─┬─┬─┬─┬─┬──┬──┬──────┐ │ │ │ 1│ 1│ 1│ 1│ 1│ 1│ 1│ 1│ 1│ 1│ 1│ 1│ 1│ 1│ 1│ 1│ 1│ 1│ 1│ │ 1│ 1│ 1│ 1│ 2│ 1│ 1│ 1│ 1│ │ │ 29 │ │ ├─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼──┼──┼──────┤ │ │ 1│ 2│ 3│ 4│ 5│ 6│ 7│ 8│ 9│10│11│12│13│14│15│16│17│18│19│20│21│22│23│24│25│26│27│28│29│30│31│ │ │ │ ├─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼──┼──┼──────┤ │ │火│水│木│金│土│日│月│火│水│木│金│土│日│月│火│水│木│金│土│日│月│火│水│木│金│土│日│月│火│水│木│ │ │ │ ├─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼──┼──┼──────┤ │a │休│ │ │休│ │ │休│ │ │休│ │ │休│ │ │休│ │ │休│ │ │休│ │ │休│ │ │休│ │ │休│ │ │ │ │b │ │ │ │ │休│休│ │ │休│ │ │休│ │ │休│ │ │休│ │ │休│ │ │ │ │休│ │ │休│ │ │ │ │ │ │c │ │ │休│ │ │ │ │ │ │ │ │休│休│休│ │ │ │休│ │ │休│ │ │休│ │ │休│ │ │休│ │ │ │ │ │d │ │休│ │ │休│ │ │休│ │ │休│ │ │休│ │ │ │ │ │ │ │ │ │ │ │休│ │ │休│ │ │ │ │ │ │e │ │休│ │ │休│ │ │休│ │ │休│ │ │休│ │ │休│ │ │休│ │ │休│ │ │ │ │ │ │ │ │ │ │ │ │f │休│ │ │休│ │ │休│ │ │休│ │ │休│ │ │休│ │ │休│ │ │休│ │ │休│ │ │休│ │ │休│ │ 2 │16,28 │ │g │ │ │ │ │ │休│ │ │ │ │ │休│ │ │ │休│ │ │休│ │ │休│ │ │休│ │ │休│ │ │休│ │ 2 │19,28 │ │h │ │休│ │ │休│ │ │休│ │ │休│ │ │休│ │ │休│ │ │休│ │ │休│ │ │休│ │ │休│ │ │ │ │ │ │i │ │ │休│日│休│休│ │ │ │ │ │ │ │ │ │ │ │ │ │ │ │ │ │ │ │ │ │ │ │ │ │ │ 1 │4 │ │j │休│ │ │休│ │ │休│ │ │ │休│ │ │ │ │日│ │ │ │ │ │ │ │ │ │ │休│ │ │休│ │ │ 2 │10,13 │ │k │ │休│ │ │休│ │ │休│ │ │休│ │ │休│ │ │休│ │ │休│ │ │休│ │ │休│ │ │ │ │ │ │ 2 │8,17 │ │l │ │休│ │ │休│ │ │ │ │ │ │ │ │休│ │ │ │ │ │休│ │ │休│ │ │休│ │ │休│ │ │ │ 2 │20,29 │ │m │ │ │休│ │ │休│ │ │休│ │ │休│ │ │休│日│ │ │ │ │ │ │ │ │ │ │休│ │ │休│ │ │ 3 │3,9,30 │ │n │ │ │休│ │ │休│ │ │休│ │ │休│ │ │休│ │ │休│ │ │休│ │ │休│ │ │休│ │ │休│ │ │ 2 │15,27 │ │o │ │ │休│ │ │休│ │ │休│ │ │休│ │ │休│ │ │休│ │ │休│ │ │休│ │ │ │ │ │ │ │ │ 4 │6,12,18,24 │ │p │休│ │ │休│ │ │休│ │ │ │ │ │ │ │ │ │ │ │休│ │ │休│ │ │休│ │ │休│ │ │休│ │ 3 │7,22,24 │ │q │ │休│ │ │休│ │ │休│ │ │休│ │ │休│ │ │休│ │ │休│ │ │休│ │ │休│ │ │ │ │ │ │ 3 │2,11,26 │ │r │ │休│ │ │休│ │ │休│ │ │休│ │ │休│ │ │休│ │ │休│ │ │休│ │ │休│ │ │休│ │ │ │ 2 │5,23 │ │s │ │ │ │ │ │ │ │ │ │ │ │ │ │休│ │ │休│ │ │休│日│日│日│ │ │ │ │ │ │ │ │ │ 1 │14 │ └─┴─┴─┴─┴─┴─┴─┴─┴─┴─┴─┴─┴─┴─┴─┴─┴─┴─┴─┴─┴─┴─┴─┴─┴─┴─┴─┴─┴─┴─┴─┴─┴──┴──┴──────┘
残念ながら(1).(3)は理解できないです。
そもそもこの表が、「抽出」前のものなのか、「抽出」後の完成品なのかもわからないです。
（チオチモリン） 2019/01/03(木) 15:12
表はただのシフト表です。 抽出という言葉が不適切でした。 シフト表があって、1人辺りの割り振り回数を決めたら、その回数分”休”と”日”にあたる日付をランダムに選択したい、ということです。
上の人回数の日付は1月の実際のデータです。 （前） 2019/01/03(木) 15:25
こんばんは！ 思いっきり力業ですけど、何かの足しになればと、、、、
ちょっと全体を表示できないんで簡易版ですけど、 そのシフト表の隣にAH列に=rand()を入力しておきます。
次に、上の三段日付や曜日のところは=B1としてリンクさせておきます。 次に、AI4に=INDEX($A$4:$AF$22,RANK($AH4,$AH$4:$AH$22,ROW(A1)),COLUMN(A1)) と入力して配列(Ctrl+Shift+Enter）で確定して右に下に必要数フィルします。
0 表示が気になりますから表示形式を # にして 0 を消します。
で、F9を押すとシフト表が並び替わりますから、一番上に来た人から順に人数に応じて色をつけます。 これを、1日から31日まで繰り返します。おみくじ感覚で楽しみながら(笑) 抽出する人は上から順番です。←これはルールの一例です。
休が並んでいる時は、どうするとか細かいルールはトピ主さんが決められればいいでしょう？
ルールと法則とか色々あるでしょうけど、人力で考えるよりはましかなと(笑)
どうでしょう？
=B1
1 1 1 1 1 1
1 2 3 4 5 6 7
火 水 木 金 土 日 月
=rand() =INDEX($A$4:$AF$22,RANK($AH4,$AH$4:$AH$22,ROW(A1)),COLUMN(A1))
0.284404412 c 休
0.401876686 f 休 休 休
0.691038187 j 休 休 休
0.272445387 b 休 休
0.352693552 d 休 休
0.504246398 g 休
0.573673344 i 休 日 休 休
0.751771116 l 休 休
0.790380459 o 休 休
0.924922698 r 休 休
0.740389563 k 休 休
0.773408391 m 休 休
0.903608033 p 休 休 休
0.564580652 h 休 休
0.777411999 n 休 休
0.360763772 e 休 休
0.904633142 q 休 休
（SoulMan） 2019/01/03(木) 16:46
SoulManさんありがとうございます。 力技···いやいやシンプルな方法ですよ! 最終的に判別するのは人の目ですからね···。並び順だけランダムに、残りは人がというのは臨機応変に対応出来ると思います。 感謝です。 （前） 2019/01/03(木) 19:06
いやあ結構むずかしい。 N クイーン問題みたいにトライしてみたけど、何せあり得る組み合わせは膨大なので 件の最初のトライは、4時間弱たっていたが終了せず。泣く泣く Kill しました。
ランダムに検索する方法に変えてみたけど、なかなかヒットしません。 ただし、幸運にも下記の別解が見つかりました。
f 2 10,13 g 2 22,28 i 1 4 j 2 16,27 k 2 5,20 l 2 26,29 m 3 3,12,30 n 2 15,24 o 4 6,9,18,24 p 3 7,19,28 q 3 2,8,11 r 2 14,23 s 1 17
これだと余り褒められないな。 もっとエレガントなものをどなたかお願いします。
（γ） 2019/01/03(木) 22:58
抽出の優先順位を にしてみたら、簡単にヒットしました。 ↓ 今後の選択肢数(昇順）＞残回数(降順）＞最終割当日(昇順)＞名簿(ランダム)
1月用データが、たまたまその処理に合っていたのかも知れません。 データの有り様で難易度が上がったり下がったりするんでしょうね・・多分
作業用エリアとして AI〜BV列を使用します。
優先順位を付けているので、バリエーションは殆ど無いです。
結果は、AI4セル以下に表示されます。
<サンプル>
行 ___A___ _B_ _C_ _D_ _E_ _F_ _G_ _H_ _I_ _J_ _K_ _L_ _M_ _N_ _O_ _P_ _Q_ _R_ _S_ _T_ _U_ _V_ _W_ _X_ _Y_ _Z_ _AA_ _AB_ _AC_ _AD_ _AE_ _AF_ _AG_
1 回数 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 2 1 1 回数
2 日付 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31
3 曜日 火 水 木 金 土 日 月 火 水 木 木
4 氏名01 休 休 休 休 休 休 休 休 休 休 休
: : :
<結果図> 行 __________ AI __________ _AJ_ _AK_ _AL_ _AM_ _AN_ 1 回数 1 1 1 1 2 日付 1 2 3 4 5 3 4 氏名06 2回 10,13 5 氏名07 2回 25,28 6 氏名09 1回 3 7 氏名10 2回 4,11 8 氏名11 2回 17,23 9 氏名12 2回 2,5 10 氏名13 3回 12,16,27 11 氏名14 2回 24,30 12 氏名15 4回 6,9,15,18 3 13 氏名16 3回 7,19,28 4 14 氏名17 3回 8,14,20 15 氏名18 2回 26,29 2 5 16 氏名19 1回 22
実行マクロ名は「holidayExtract」
’シートモジュールにコピペするコード（一括貼り付け） ↓
Option Explicit
Private Const numOfRows As Long = 20 '対象人数
Private DayTimesAry As Range Private RngSRC As Range Private RngDST As Range Private RngRowNum As Range Private RngRemaining As Range Private RngToSort As Range Private RngPreDay As Range
Sub holidayExtract()
Dim Cel As Range, i As Long, RW As Long, rwIndex As Long, NN As Long
Dim 名簿Num, cntLeft As Long, KK As Long
'環境設定
Call init
'作業範囲をクリアする
Range("AI4:BV4").Resize(100).ClearContents
'AI列に名簿番号を振り、BO列にランダムな背番号を振る
Range("AI4").Resize(numOfRows).FormulaLocal = "=row()-3"
Range("BQ4").Resize(numOfRows).FormulaLocal = "=rand()"
Range("AI4:BQ4").Resize(numOfRows).Value = Range("AI4:BQ4").Resize(numOfRows).Value
Range("AI1:BO2").Value = Range("A1:AG2").Value
'回数を残回数に転記する
RngRemaining.Value = Range("AG4").Resize(numOfRows).Value
'作業表の3行目にチェック用数式を入力する
Range("AJ3:BO3").FormulaR1C1 = _
"=IF(ISNUMBER(R[-2]C),IF(COUNT(R[1]C:R[27]C)=R[-2]C,"""",""NG""),"""")"
Range("BP3:BV3") = [{"前回日","ランダム背番号","","名簿番号","残回数","前回日","ランダム背番号"}]
Application.ScreenUpdating = False
'優先度→ 今後の選択肢数(昇順）＞残回数(降順）＞最終割当日(昇順)＞名簿(ランダム)
For i = 2 To 32
rwIndex = 0 '各日の候補抽出数
If DayTimesAry(1, i) > 0 Then
For RW = 1 To numOfRows
If RngRemaining(RW, 1) > 0 Then
If isEligible(RngSRC(RW, i)) Then '適格性チェック
rwIndex = rwIndex + 1
RngToSort(rwIndex, 1) = RngDST.Cells(RW, 1).Value '名簿番号
RngToSort(rwIndex, 2) = RngDST.Cells(RW, 33).Value '残回数
'選択肢の少ない方を優先させる為、今後の選択肢数を算出
cntLeft = 0
For KK = i To 32
If isEligible(RngSRC(RW, KK)) Then
cntLeft = cntLeft + 1
End If
Next KK
RngToSort(rwIndex, 2) = RngToSort(rwIndex, 2) + 1000 - cntLeft
RngToSort(rwIndex, 3) = RngDST.Cells(RW, 34).Value '前回日
RngToSort(rwIndex, 4) = RngDST.Cells(RW, 35).Value 'ランダム背番号
End If
End If
Next RW
End If
If rwIndex > 0 Then 'ソートする
ActiveSheet.Sort.SortFields.Clear
ActiveSheet.Sort.SortFields.Add Key:=Range("BT4"), Order:=xlDescending
ActiveSheet.Sort.SortFields.Add Key:=Range("BU4"), Order:=xlAscending
ActiveSheet.Sort.SortFields.Add Key:=Range("BV4"), Order:=xlAscending
With ActiveSheet.Sort
.SetRange RngToSort
.Header = xlNo
.Apply
End With
'ソート結果を反映させる
For NN = 1 To Application.Min(DayTimesAry(1, i), rwIndex)
名簿Num = RngToSort(NN, 1) '名簿番号
RngDST(名簿Num, i) = i - 1
RngRemaining(名簿Num, 1) = RngRemaining(名簿Num, 1) - 1
RngPreDay(名簿Num, 1) = i - 1
Next NN
'更地化（次の列処理に備える）
RngToSort.ClearContents
End If
Next i
Application.ScreenUpdating = True
If 未達Zecke > 0 Then
Debug.Print "未達者あり"
最終調整 '未達者が残った場合の追加処理
Else
Debug.Print "未達者無し"
showResult
End If
End Sub
Private Sub init()
Set RngRemaining = Range("BO4").Resize(numOfRows)
Set DayTimesAry = Range("A1:AF1")
Set RngSRC = Range("A4:AG4").Resize(numOfRows) '前後の列を含める
Set RngDST = Range("AI4:BQ4").Resize(numOfRows) '名簿番号列から前回日列まで含める
Set RngToSort = Range("BS4:BV4").Resize(numOfRows)
Set RngPreDay = Range("BP4").Resize(numOfRows)
End Sub
'抽出可否判定
Private Function isEligible(cellToTest As Range) As Boolean
If cellToTest = "日" Or (cellToTest = "休" And _
Application.CountIf(cellToTest.Offset(, -1).Resize(1, 3), "休") = 1) Then
isEligible = True
End If
End Function
Private Function 未達Zecke() As Long '未達者チェック
Dim RW As Long
For RW = 1 To numOfRows
If RngRemaining(RW, 1) > 0 Then
未達Zecke = RW
Exit For
End If
Next RW
End Function
Private Function 未達Day() As Long '未達日チェック
Dim CL As Long
For CL = 1 To 31
If DayTimesAry(1, CL + 1) > 0 Then
If Application.Count(RngDST.Columns(CL + 1)) < DayTimesAry(1, CL + 1) Then
未達Day = CL
Exit For
End If
End If
Next CL
End Function
Private Function getExchanged(未達Zecke, 未達Day) As Range
Dim aRow As Range
Dim Cel As Range
Dim RW As Long, CL As Long
Dim celToMove(1 To 2) As Range '確定を変更 1→２
Dim celToNewAsign As Range
For CL = 1 To 31
If IsEmpty(RngDST(未達Zecke, CL + 1)) Then '未達者で割り当てられていない日をチェックして行く
If isEligible(RngSRC(未達Zecke, CL + 1)) Then 'それが適格かどうかチェックする
Set celToMove(2) = RngDST.Cells(未達Zecke, CL + 1)
For RW = 1 To numOfRows '当該列中に交換可能な他の名簿番号があるかチェックする
If RngRemaining(RW, 1) & "" = "0" Then
If RngDST(RW, CL + 1).Value Then '交換可能な日付をチェック
Set celToMove(1) = RngDST.Cells(RW, CL + 1)
If isEligible(RngSRC(RW, 未達Day + 1)) Then '交換可能な日付なら
Set celToNewAsign = RngDST(RW, 未達Day + 1)
Debug.Print celToNewAsign.Address, celToMove(1).Address, celToMove(2).Address
Union(celToNewAsign, celToMove(1), celToMove(2)).Select
Stop
celToNewAsign.Value = 未達Day
celToMove(2) = celToMove(1).Value
celToMove(1) = Empty
RngRemaining(未達Zecke, 1) = RngRemaining(未達Zecke, 1) - 1
Exit Function
End If
End If
End If
Next RW
End If
End If
Next CL
End Function
Private Sub 最終調整()
Dim 未達名簿 As Long, 未達日 As Long
Dim RW As Long, CL As Long
Dim Limit As Long
' Call init
未達名簿 = 未達Zecke
未達日 = 未達Day
Do While 未達名簿 > 0 And Limit < 100
If 未達名簿 > 0 Then
Call getExchanged(未達名簿, 未達日)
End If
未達名簿 = 未達Zecke
Limit = Limit + 1
If Limit >= 100 Then
MsgBox "トライリミットに達しました。再実行してください"
End If
Loop
If 未達Day > 0 Then
MsgBox "ありえない事態が生じました。処理中止"
Exit Sub
Else
showResult
End If
End Sub
Private Sub showResult()
Dim RW As Long, CL As Long, Pos As Long
Dim Result(), length As Long
ReDim Result(1 To numOfRows, 1 To 1)
length = [MAX(LEN(A1:A200))]
For RW = 1 To numOfRows
If RngRemaining(RW, 1) & "" = "0" Then
Pos = Pos + 1
Result(Pos, 1) = Left(RngSRC(RW, 1) & Space(15), length + 2) & Format(RngSRC(RW, 33), "##回 ")
For CL = 1 To 31
If RngDST(RW, CL + 1) <> "" Then
Result(Pos, 1) = Result(Pos, 1) & "," & RngDST(RW, CL + 1)
End If
Next CL
Result(Pos, 1) = Replace(Result(Pos, 1), ",", "", 1, 1)
End If
Next RW
Range("AI4").Resize(numOfRows) = Result
End Sub
（ 半平太） 2019/01/04(金) 19:25
一点質問があります。
>実行マクロ名は「holidayExtract」
これはシートモジュールに貼り付けたマクロに名前を付けるということでしょうか。
普段記録をとって標準モジュールで編集してボタンで···くらいしかマクロ使わないので、シートモジュールに貼り付けるだけで大丈夫でしょうか。
（前） 2019/01/04(金) 21:44
すみません。たまたま旨く行ったみたいです。
＞RngToSort(rwIndex, 2) = RngToSort(rwIndex, 2) + 1000 - cntLeft ↑ ロジックとしては、これは間違いで、こっちが正しいんですが、 ↓ RngToSort(rwIndex, 2) = RngToSort(rwIndex, 2) + (1000 - cntLeft) * 100
そう修正すると収束しません。 ごめんなさい m(__)m
＞シートモジュールに貼り付けるだけで大丈夫でしょうか。
大丈夫です。 (※) 標準モジュールに貼り付けた場合は、そのシートをアクティブにして実行する必要があります。
と言ったところで、上述の問題があるので使い物にならないかも知れません。 更なる検討をする予定はありません。m(__)m
（ 半平太） 2019/01/04(金) 22:24
···ただ、会社のパソコンオフラインなんですよね···。入力ミス含めて何時間かかるんですかね···。
（前） 2019/01/05(土) 09:32
＞・・・ただ、会社のパソコンオフラインなんですよね・・・。入力ミス含めて何時間かかるんですかね・・・。
その作業はちょっと待ってください。
「最終調整」の処理がこんなにワークしないというのも、自分のセイながら腑に落ちないです。
もうちょっとマシなロジックが組めないか、気を取り直して考えてみます。
（ 半平太） 2019/01/05(土) 10:20
ランダムに抽出というよりは、複数解のあるパズルを解くようなものですから、
縦横の残数を見ながら適当にやっても１０分程度の作業時間じゃないですか。
〜〜〜〜〜〜〜〜〜 一応解いた証として解の一例を示しときます。
f 10,13 g 19,28 h i 4 j 7,16 k 2,26 l 5,29 m 9,27,30 n 18,24 o 3,6,12,15 p 22,25,28 q 8,14,23 r 11,17 s 20 〜〜〜〜〜〜〜〜〜 用途を邪推すると 勤務予定に欠損が出た時の勤務者確保のための待機の割当（当番）ですかね。 そうならば、２名以上の場合も考慮しとかないといけないですが、別ルールがあるんでしょうね。
（チオチモリン） 2019/01/05(土) 13:48
力業だけじゃ寂しいからわちきもちょっと書いてみますた。 でも、抽出するだけで、休が連続とかの細かいところはみていません。 一応、↓こんなんが出てきます。
後は、ご自身で修正してください。(笑) すみません。m(__)m q 1 2 o 2 23,24 p 2 16,19 i 2 5,6 j 1 7 k 2 16,17 m 2 26,27 f 3 26,27,28 r 2 16,20 n 1 12 s 1 14 a 1 16 h 1 23 g 2 26,28 b 1 26 d 1 29 c 1 30
' ＶＢＡによるメルセンヌツイスタ
Option Explicit
' システムを起動してからの時間をミリ秒単位で返す
' ht tp://msdn.microsoft.com/ja-jp/library/cc429827.aspx
Private Declare Function GetTickCount Lib "kernel32" () As Long
' メルセンヌツイスタのパラメータ(ダイナミッククリエーターの結果)
Private Const MTN = 644, MTM = 322, MTA = 12, MTB = 7, MTC = 15, MTD = 18
Private Const MXA = &H70C20000, UMK = &H78000000, LMK = &H7FFFFFF
Private Const MKB = &H73736B80, MKC = &H6ED28000
' 補助的な定数の宣言
Private Const MTL = MTN - MTM, MTK = MTN - 1, MTJ = MTL - 1, MTP = MTN - 2
Private Const PWA = 2 ^ MTA, PWB = 2 ^ MTB, PWC = 2 ^ MTC, PWD = 2 ^ MTD
Private Const KB = MKB \ PWB, KC = MKC \ PWC
Private Const P32 = 2# ^ 32, P31 = 2 ^ 31, P22 = 2# ^ 22, P9 = 2 ^ 9
Private Const M53 = 2# ^ -53, M32 = 2# ^ -32, M30 = 2# ^ -30
' 乱数の状態
Private mt(0 To MTK), mti As Long
' 初期化の補助関数
Private Function Ri(ByRef r As Double, ByVal i As Long) As Long
Dim s As Variant
Dim shft As Double
Dim a As Long
If r >= P31 Then a = r - P32 Else a = r
a = a Xor Int(r * M30)
If a < 0 Then r = a + P32 Else r = a
s = 1812433253 * CDec(r) + i: r = s - CDec(Int(s * M32)) * P32
If r >= P31 Then Ri = r - P31 Else Ri = r
End Function
' s を種にして乱数を初期化する
Public Sub InitMt(ByVal s As Long)
Dim r As Double
mt(0) = s And &H7FFFFFFF
If s < 0 Then r = P32 + s Else r = s
For mti = 1 To MTK: mt(mti) = Ri(r, mti): Next mti
mti = MTN
End Sub
' 31 ビットの整数乱数
Public Function NextMt() As Long
Dim y, k As Long
If mti = 0 Then InitMt (1)
If mti = MTN Then
mti = 0
For k = 0 To MTJ
y = (mt(k) And UMK) Or (mt(k + 1) And LMK)
mt(k) = mt(k + MTM) Xor (y \ 2) Xor (-(y And 1) And MXA)
Next k
For k = MTL To MTP
y = (mt(k) And UMK) Or (mt(k + 1) And LMK)
mt(k) = mt(k - MTL) Xor (y \ 2) Xor (-(y And 1) And MXA)
Next k
y = (mt(MTK) And UMK) Or (mt(0) And LMK)
mt(MTK) = mt(MTM - 1) Xor (y \ 2) Xor (-(y And 1) And MXA)
End If
y = mt(mti): mti = mti + 1
y = y Xor (y \ PWA): y = y Xor ((y And KB) * PWB)
y = y Xor ((y And KC) * PWC): y = y Xor (y \ PWD): NextMt = y
End Function
' 0 以上 1 未満の乱数を返す
Public Function NextUnifMt() As Double
Dim x As Long
x = NextMt \ P9: NextUnifMt = (NextMt * P22 + x) * M53
End Function
' 時間を種にして乱数を初期化する
Public Sub RandomizeMt()
InitMt (GetTickCount())
End Sub
Sub てすと()
Dim MyA As Variant
Dim MyB As Variant
Dim MyAry() As Variant
Dim 出勤日() As Variant
Dim MyDic As Object
Dim x As Variant
Dim xx() As Variant
Dim MyKeys As Variant
Dim MyItems As Variant
Dim nn As Variant
Dim i As Long
Dim j As Long
Dim k As Long
Dim n As Long
Dim r As Long
Set MyDic = CreateObject("Scripting.Dictionary")
With Sheets("Sheet1")
With .Range("A1", .Range("A" & .Rows.Count).End(xlUp))
MyA = .Resize(, 32).Value
MyB = .Offset(3).Resize(.Rows.Count - 3, 32).Value
End With
End With
k = 0
For j = LBound(MyA, 2) To UBound(MyA, 2)
'おっさんなんべんすんねん (￣▽￣;)
これくしょんでしゃっふるぅぅぅ MyB
r = 0
If MyA(1, j) > 0 Then
n = Application.CountA(Application.Index(MyB, 0, j))
If MyA(1, j) <= n Then
For i = LBound(MyB, 1) To UBound(MyB, 1)
If MyB(i, j) <> "" Then
r = r + 1
If r > MyA(1, j) Then Exit For
k = k + 1
ReDim Preserve MyAry(1 To 3, 1 To k)
'名前
MyAry(1, k) = MyB(i, 1)
'日付
MyAry(3, k) = MyA(2, j)
End If
Next
End If
End If
Next
For j = LBound(MyAry, 2) To UBound(MyAry, 2)
If Not MyDic.Exists(MyAry(1, j)) Then
ReDim x(1)
k = x(1)
k = k + 1
ReDim Preserve xx(k)
xx(k) = MyAry(3, j)
x(1) = xx
MyDic(MyAry(1, j)) = x
Else
MyItems = MyDic(MyAry(1, j))
k = UBound(MyItems(1)) + 1
ReDim Preserve xx(k)
xx(k) = MyAry(3, j)
x(1) = xx
MyDic(MyAry(1, j)) = x
End If
Next
MyItems = MyDic.Items
MyKeys = MyDic.Keys
For i = LBound(MyItems) To UBound(MyItems)
k = 0
nn = MyItems(i)
For j = LBound(nn(1)) To UBound(nn(1))
If nn(1)(j) <> Empty Then
ReDim Preserve 出勤日(k)
出勤日(k) = nn(1)(j)
k = k + 1
End If
Next
x = MyDic(MyKeys(i))
x(1) = Join(出勤日, ",")
x(0) = UBound(Split(x(1), ",")) + 1
MyDic(MyKeys(i)) = x
Next
MyItems = MyDic.Items
MyKeys = MyDic.Keys
ReDim MyAry(1 To MyDic.Count, 1 To 3)
For i = LBound(MyAry, 1) To UBound(MyAry, 1)
MyAry(i, 1) = MyKeys(i - 1)
MyAry(i, 2) = MyItems(i - 1)(0)
MyAry(i, 3) = MyItems(i - 1)(1)
Next
With Sheets("Sheet2")
.Cells.Clear
.Range("A1").Resize(UBound(MyAry, 1), UBound(MyAry, 2)).Value = MyAry
.Range("A1").CurrentRegion.EntireColumn.AutoFit
End With
Set MyDic = Nothing
Erase MyA, MyB, MyAry, 出勤日, x, xx, MyKeys, MyItems, nn
MsgBox "処理が完了しました"
End Sub
Private Sub これくしょんでしゃっふるぅぅぅ(ByRef x As Variant)
Dim y As Variant
Dim i As Long
Dim j As Long
Dim MyScs As Object
Set MyScs = CreateObject("System.Collections.SortedList")
ReDim y(LBound(x, 1) To UBound(x, 1), LBound(x, 2) To UBound(x, 2))
RandomizeMt
For i = LBound(x, 1) To UBound(x, 1)
MyScs(NextUnifMt()) = i
Next
For i = 0 To MyScs.Count - 1
For j = LBound(x, 2) To UBound(x, 2)
y(i + 1, j) = x(MyScs.GetByIndex(i), j)
Next
Next
x = y
Set MyScs = Nothing
Erase y
End Sub
v(=∩_∩=)v
※今からちょっとお馬ちゃんモードに入ります。すみません。当てるどぉ〜〜〜〜！！！！
（SoulMan） 2019/01/05(土) 13:59
１．「最終調整」の処理はすごく面倒だし、それで解決する保証もないので、取りやめます。
おかげでコード量が減ります。
２．代わって「残りの日全体を見渡して、一人しか担当できない日が生じたら、その人を先に割り当てる」と言うロジックを追加します。
これは、結構いいアイデアだった。一発で成功しました。(たまたまじゃないことを祈る）
３．もう一つ、「一回目のトライでマズい場合は、マズかった人を記憶しておいて、2回目はその人を優先処理する」 と言うのも思いついたのですが、他の人の回答もついているので、こっちアイデアは保留します。
成功結果は、AI列の４行目以下に表示されます。
コピペするコード
Option Explicit
Private Const numOfRows As Long = 20 '対象人数
Private DayTimesAry As Range Private RngSRC As Range Private RngDST As Range Private RngRowNum As Range Private RngRemaining As Range Private RngToSort As Range Private RngPreDay As Range
Sub holidayExtract()
Dim Cel As Range, i As Long, RW As Long, rwIndex As Long, NN As Long
Dim 名簿Num, cntLeft As Long, KK As Long
'環境設定
Call init
'作業範囲をクリアする
Range("AI4:BV4").Resize(100).ClearContents
'AI列に名簿番号を振り、BO列にランダムな背番号を振る
Range("AI4").Resize(numOfRows).FormulaLocal = "=row()-3"
Range("BQ4").Resize(numOfRows).FormulaLocal = "=rand()"
Range("AI4:BQ4").Resize(numOfRows).Value = Range("AI4:BQ4").Resize(numOfRows).Value
Range("AI1:BO2").Value = Range("A1:AG2").Value
'残回数の算出数式を入力する
Range("BO4").Resize(numOfRows).FormulaR1C1 = _
"=IF(RC[-34]="""","""",RC[-34]-COUNT(RC[-31]:RC[-1]))"
'作業表の3行目にチェック用数式を入力する
Range("AJ3:BO3").FormulaR1C1 = _
"=IF(ISNUMBER(R[-2]C),IF(COUNT(R[1]C:R[27]C)=R[-2]C,"""",""NG""),"""")"
Range("BP3:BV3") = [{"前回日","ランダム背番号","","名簿番号","残回数","前回日","ランダム背番号"}]
Application.ScreenUpdating = False
'優先度→ 今後の選択肢数(昇順）＞残回数(降順）＞最終割当日(昇順)＞名簿(ランダム)
For i = 2 To 32
'各日に選択肢が一つしかない人を優先処理
firstPriorityProc
rwIndex = 0 '各日の候補抽出数
If DayTimesAry(1, i) > 0 Then
For RW = 1 To numOfRows
If IsEmpty(RngDST(RW, i)) And CStr(RngRemaining(RW, 1)) > "0" Then
If isEligible(RngSRC(RW, i)) Then '適格性チェック
rwIndex = rwIndex + 1
RngToSort(rwIndex, 1) = RngDST.Cells(RW, 1).Value '名簿番号
RngToSort(rwIndex, 2) = RngDST.Cells(RW, 33).Value '残回数
'選択肢の少ない方を優先させる為、今後の選択肢数を算出
cntLeft = 0
For KK = i To 32
If isEligible(RngSRC(RW, KK)) Then
cntLeft = cntLeft + 1
End If
Next KK
' RngToSort(rwIndex, 2) = RngToSort(rwIndex, 2) + 1000 - cntLeft
RngToSort(rwIndex, 2) = RngToSort(rwIndex, 2) + (1000 - cntLeft) * 100
RngToSort(rwIndex, 3) = RngDST.Cells(RW, 34).Value * 1 '前回日
RngToSort(rwIndex, 4) = RngDST.Cells(RW, 35).Value 'ランダム背番号
End If
End If
Next RW
End If
If rwIndex > 0 Then 'ソートする
ActiveSheet.Sort.SortFields.Clear
ActiveSheet.Sort.SortFields.Add Key:=Range("BT4"), Order:=xlDescending
ActiveSheet.Sort.SortFields.Add Key:=Range("BU4"), Order:=xlAscending
ActiveSheet.Sort.SortFields.Add Key:=Range("BV4"), Order:=xlAscending
With ActiveSheet.Sort
.SetRange RngToSort
.Header = xlNo
.Apply
End With
'ソート結果を反映させる
For NN = 1 To Application.Min(DayTimesAry(1, i), rwIndex)
名簿Num = RngToSort(NN, 1) '名簿番号
RngDST(名簿Num, i) = i - 1
RngPreDay(名簿Num, 1) = i - 1
Next NN
'更地化（次の列処理に備える）
RngToSort.ClearContents
End If
Next i
Application.ScreenUpdating = True
'結果表示
If [AND(SUM((BO4:BO100<>0)*(BO4:BO100<>""))=0,COUNTBLANK(AJ3:BN3)=31)] Then
showResult
Else
MsgBox "不成功でした。再トライしてみてください"
End If
End Sub
Private Sub init()
Set RngRemaining = Range("BO4").Resize(numOfRows)
Set DayTimesAry = Range("A1:AF1")
Set RngSRC = Range("A4:AG4").Resize(numOfRows) '前後の列を含める
Set RngDST = Range("AI4:BQ4").Resize(numOfRows) '名簿番号列から前回日列まで含める
Set RngToSort = Range("BS4:BV4").Resize(numOfRows)
Set RngPreDay = Range("BP4").Resize(numOfRows)
End Sub
'抽出可否判定
Private Function isEligible(cellToTest As Range) As Boolean
If cellToTest = "日" Or (cellToTest = "休" And _
Application.CountIf(cellToTest.Offset(, -1).Resize(1, 3), "休") = 1) Then
isEligible = True
End If
End Function
Private Sub firstPriorityProc()
Dim RW As Long, CL As Long
Dim Choice(1 To 2) As Long
For CL = 1 To 31
If Range("AJ3:BN3")(1, CL) = "NG" Then
For RW = 1 To numOfRows
If CStr(RngRemaining(RW, 1)) > "0" Then
If isEligible(RngSRC(RW, CL + 1)) Then
Choice(1) = Choice(1) + 1
Choice(2) = RW
End If
End If
Next
End If
If Choice(1) = 1 Then
RngDST(Choice(2), CL + 1) = CL
End If
Erase Choice
Next CL
End Sub
Private Sub showResult()
Dim RW As Long, CL As Long, Pos As Long
Dim Result(), length As Long
ReDim Result(1 To numOfRows, 1 To 1)
length = [MAX(LEN(A1:A200))]
For RW = 1 To numOfRows
If CStr(RngRemaining(RW, 1)) = "0" Then
Pos = Pos + 1
Result(Pos, 1) = Left(RngSRC(RW, 1) & Space(15), length + 2) & Format(RngSRC(RW, 33), "##回 ")
For CL = 1 To 31
If RngDST(RW, CL + 1) <> "" Then
Result(Pos, 1) = Result(Pos, 1) & "," & RngDST(RW, CL + 1)
End If
Next CL
Result(Pos, 1) = Replace(Result(Pos, 1), ",", "", 1, 1)
End If
Next RW
Range("AI4").Resize(numOfRows) = Result
End Sub
（ 半平太） 2019/01/05(土) 15:23
＞どうしても28日がNGになりますが
こちらに提示したデータと違うんじゃないですか？
極端な話 二人が各1回しか出られなくて、 しかも同日にしか出られなくて、 その日は1人だけしか必要ない
そんな場合、絶対に成立しませんけど？ （ 半平太） 2019/01/05(土) 16:46
私は乱数設定による力づく方法をチューニングしていました。
というか別の処理系のコーディング練習の題材にさせていただいていました。ペコリ。
大分慣れることができました。
100万個のケースを試行させると、17個ほど見つかりました。（ちょっと見、それぞれ違うようです）。
時間は10秒程度でした。
＝＝ 17 回目の成功 ＝＝＝＝＝＝＝＝＝＝
a[0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0] b[0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0] c[0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0] d[0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0] e[0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0] f[0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0] g[0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 1, 0, 0, 0] h[0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0] i[0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0] j[0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0] k[0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0] l[0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 1, 0, 0] m[0, 0, 1, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0] n[0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0] o[0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 1, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0] p[0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0] q[0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0] r[0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0] s[0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0] 10.494692 seconds (65.93 M allocations: 9.433 GiB, 11.78% gc time)
コードは、地道に、各日の選択肢をランダムに選択し、横計が目標値に一致するかどうかを確認しています。
なお、最初に、
各日の必要数と、設定可能者の合計が同じところは選択を確定させたり、
日別の必要数がゼロのところは、最初から省いて計算効率を上げるようにしました。
あいにく、VBAではないので提示できませんが。
（数値を差し替えました）
（γ） 2019/01/05(土) 23:37
＞どうしても28日がNGになりますが、1日だけです
: : :
＞別の月のデータを使用してました
でしたら、以下のシフト表を作ってテストしてみたらどうですかね。
(１) 28日の２回は無しにする。 (２) 28日に出られる人を２人選んで、その人達の出番を各１回減らす。
そのテストで旨く行けば、完成結果に上の二つを手動で加味する。
旨く行かず、こんどは別の日がNGになれば、解が無いっぽいです。
そのテストデータを提示して、γさんの処理系プログラムに掛けたらどうなるか ・・なんて考えると、すごく興味が湧いてきます・・
（ 半平太） 2019/01/05(土) 23:51
だいぶ遅い時間ですが。 暇を見つけながら会社のPCに入力してました。時間はかかりましたが家のPCで使った単純なシフト表と同じ結果が出たので多分コピペ出来たと思います（思い込みたい）
>というか別の処理系のコーディング練習の題材にさせていただいていました。ペコリ。
知らないところでYさんの役に立ってたようで。こちらこそアドバイスありがとうございました。m(_ _)m
>旨く行かず、こんどは別の日がNGになれば、解が無いっぽいです。
数カ月分のデータを使って半平太さんの方法をやってみましたが、やはり必ず1、２日はNGの日が出ます。半平太さんの予想通り解が無いっぽいです。
そのデータですが、シフト表データを入力する時間（気力も）がないため提示できないです。パソコン繋がってたら簡単なんですけどね……。
自分勝手で申し訳ないです。長い間本当にありがとうございました。
（前） 2019/01/07(月) 01:41
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.