[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『シフト表について』（まっつん）
はじめまして。
当方、50人近い従業員で、シフト表を元に当番も表示する形に
変更したいとおもっております。
シフト表は
https://www.youtube.com/watch?v=X7yHIMyVX1s&list=PLauuFlD7eyY0SIyY8WnrEmgIg45vGc1xx&index=7
を元に作成しております。
A B C D E F G H I J K L … 6 1 2 3 4 5 6 7 8 9 7 NO 所属 氏名 金 土 日 月 火 水 木 金 土 8 1 １課 青山 - - 出張 出張 休 - 9 2 １課 朝野 - - - 10 3 １課 相田 - - 早 早 - 11 4 2課 赤坂 - - 休 - 12 5 2課 荒木 - - - … 55 出社人数 - - - 56 早 - - - 57 遅 - - - 58 休 - - - 59 60 48 部長 近藤 - - 出張 出張 - …
1.56〜58行目の「早」「遅」「休」は日付ごとの集計を出したい。
60行目以降の管理職の方々の早退などは含めない。
55行目は54行目までの人数から「早」「遅」「休」を差し引いた
出社人数を集計したい。
早も遅は半日出社していても１でカウントする。0.5などとはしない。
2.シフト表の所属と名前は、社員リストからリンクする
年に二回異動があるため、人数が増減します。
課も統合されたり、増えることもあるため、社員リストを行削除したり、
行の位置を変更することによって、エラーなくシフト表も変更されるようにしたい。
社員リストは下記のように作成しています。
A B C D E F G H I J K L 1 社員リスト 2 割当 2 2 1 2 2 1 1 3 8 補足 在宅 3 課 ！鍵 朝礼 ゴミ 車両 在庫 給湯 ！ﾒｰﾙ 郵便 電話 4 青山 １課 〇 〇 〇 〇 PM 12/1（会議） 5 朝野 １課 〇 〇 〇 〇 6 相田 １課 〇 〇 〇 〇 〇 12/1（会議） 7 赤坂 2課 〇 〇 〇 〇 PM 8 荒木 2課 〇 〇 〇 〇 産休 … 22 田中 経理 〇 〇 〇 〇 AM 12/1（会議） 23 松田 経理 〇 〇 〇 〇 〇 〇 12/1〜12/8 24 塩田 総務 12/11〜12/15 … 51 近藤 部長
3.当番は今後増加することもあります。
社員リストの3行目の数字は、当番の割り当て人数ですが、
月により、割り当て人数が変動あり。
休み、早退、遅刻を考慮して作成。
例：朝礼は２名ずつ、給湯は１名
〇の中から、ランダムに担当します。
（組み合う相手はいつも同じにならない）
朝礼当番→ゴミ当番を一番はじめに優先的に決める。
電話当番はすべての当番が割り当てられたあとに、
残りの人数で割り当てる。（午前と午後で４人ずつ）
社員リストの電話当番の欄に例えば「AM」とあるときは、
AMのみ担当する。
4.電話当番以外の当番は連続にならないように配慮。
朝礼とゴミ当番は特に、それぞれ２〜３日（土日祝日のぞき）あける。
電話当番は連続でもかまわない。
なるべく月、一人の当番回数が同じになるようにしたい。
5.このシフト表は総務管理職が管理し、毎月20日ぐらいに作成しています。
割り振られた当番の 「！」がついているもの以外は新たにシフト表に
反映するようにしたい。
朝礼＝セルの色がオレンジ
ゴミ＝セルの色が黄色
車両＝セルの色が茶色
給湯＝セルの色が薄ピンク
郵便＝「〒」の文字
電話＝水色と「AM」や「PM」の文字
6.電話当番だけは別シートに午前と午後に分け、表にしたい。
<例>
A B C 1 電話当番 AM PM 2 12月1日(金) 朝野 松田 3 12月2日(土) - - 4 12月3日(日) - - 5 12月4日(月) 田中 相田
7.社員リストに補足や在宅に入力がある場合は、
その日以外で当番を割り振られる。
産休でお休みされる場合は、シフト表から名前を消すのではなく、
グレーアウトにしたい。出社人数には、いれない。
８.在宅に期間は先に１５〜２０日までに総務が決め、それをシフト表に
色付けしています。
社員リストに在宅期間を入力したあと、マクロを実行すると、
その期間が色付けされるようにしたい。
すべてこのシフト表を２人がかりで手作業で行っておりますが、
簡略化できるようにしたいです。
どうかご教授よろしくお願い致します。
＜ 使用 Excel：Excel2021、使用 OS：Windows10 ＞
>すべてこのシフト表を２人がかりで手作業で行っておりますが、 >簡略化できるようにしたいです。
「したい」が盛りだくさんですが、全て手作業で行っているんですか？ 簡略化とは具体的にどういったことですか？
（tkit） 2023/12/04(月) 11:45:40
「したい」と書いておりますが、現在すべて手作業で行っています。
シフト表の、出社人数・早退遅刻休みなどの集計は関数で計算しております。
社員名も社員リストからリンクされるようにしておりますが、
異動などで行削除や入れ替えなどを行えられれば割と楽ですが、
シフト表の計算式がくるってしまうため、入力しなおしています。
当番を決めるのも人数が多い為、時間がかかります。
電話当番に関しては、現時点ではシフト表に載せておらず、
当番を割り当ててから電話当番を決めているので、別のシートに作成しております。
簡略化とは、手作業で当番を割り当てたり、別シートで電話当番を作成すると、
時間がかかることと、ランダムに組み合わせを決めているので、
会議のある日に当番を割り当ててしまったり、当番が割り当てたのに電話当番まで
割り当ててしまったりとミスをすることもあり、
そのあとの調整にもまた時間がかかるので、
マクロで割り当てできるようになったらと思い、投稿いたしました。
自分でも過去の投稿を参考にマクロに挑戦してみたのですが、
計算式やリンクが消えてしまうなど、知識がないのでうまくできませんでした。
（まっつん） 2023/12/04(月) 17:53:10
質問8は条件書式でも出来そうな気がしますけど。
要件が複雑すぎるので誰も回答する気はないと思いますよ。
私もその1人です。
今まで通りにやってください。
（IT） 2023/12/04(月) 21:44:00
コメントありがとうございます。
そうですね。
最後の一言、つらくなりました。
（まっつん） 2023/12/04(月) 21:55:12
最初に重要な１，２個の改善に絞って依頼した方が回答者もやり易いのではと。。。。
勝手な外野の意見です。
（後は、それができてから小出しで。。。。
ただし、付け足しできる範囲内で）
（外野の補欠） 2023/12/05(火) 07:00:06
> 1.56〜58行目の「早」「遅」「休」は日付ごとの集計を出したい。 ⇒COUNTIF関数で取得
> 2.エラーなくシフト表も変更されるようにしたい。 ⇒テーブル化する
> 3〜7 ⇒簡単にランダムと言いつつも、様々な条件がありますよね？ VBAで割り振ったとしても、想定していない状況や条件が追加されれば、 齟齬が生まれます。 結局、人力となるので、割り振りしやすい、重複がすぐ分かる表を 作ることがベターかと思います。
> 8他 ⇒色付けは条件付き書式で行えばいいと思います。
（tkit） 2023/12/05(火) 08:31:43
的確なアドバイスありがとうございました。
tkitさん
何度も考えていただき、ありがとうございました。
（まっつん） 2023/12/05(火) 20:15:51
＞「！鍵」 本当に頭に「！」があるんですか？ それとも説明のために書いただけですか？
○の数が意外に少ない印象がありますが、当番の人繰りは苦しいですか？ ※各自、ひと月当たり、何回くらい当番に当たるんですか？
因みに質問文の「〇」が漢数字になっていますが、記号の「○」じゃないのですね？ それとも、両者は混在記入されているんですか？
産休って、月途中で職場復帰することはないのですか？
会議は、月1回だけなんですか？ 在宅期間は、月1回だけなんですか？
マクロで当番を決める前に、本人希望とか管理者希望で、 予め「この人は、この日△△当番にする」なんて事はあるんですか？
＞休み、早退、遅刻を考慮して作成 早退や遅刻は当番に当たらない、と言う意味ですか 他の会社には、遅刻でも「午後の電話番」はやらせる、なんて所もあるらしいですが・・
＞組み合う相手はいつも同じにならない これは何の当番における組み合わせの話なんですか？
＞ なるべく月、一人の当番回数が同じになるようにしたい。 心情としては分かりますが、現実問題として、在宅や連休取得者は、出社日が少ないので、 絶対数を同じにしようとすると当番密度(？）が高くなりますよね。 この辺りはどう云う考えで(割り切りで)シフトを組んでいるのですか？
＞「！」がついているもの以外は新たにシフト表に 反映するようにしたい。 ここ、ちょっと分かりません。「新たに」とは？ なぜ鍵とメールは反映しなくていいのですか？（誰が当番か分からないじゃないですか？）
先月のシフト表と社員リストはまだ残っていますね？ (実データがどうなっているのか、後で知る必要が出てくるかも知れないのでお聞きします）
（半平太） 2023/12/06(水) 09:18:02
ご質問ありがとうございます。
・本当に頭に「！」があるんですか？
・＞「！」がついているもの以外は新たにシフト表に 反映するようにしたい。
なぜ鍵とメールは反映しなくていいのですか？
「！」はついています。
シフト表は総務管理職が管理しており、「！」マークのものは全員が見られるシフト表には
載せないようにしています。
前に鍵当番もシフト表に載せていたのですが、社員間で勝手な交代をし、
運の悪いことが重なり、鍵が開かない、紛失などトラブルがありました。
メールに関しても、似たような問題がありました。
ですから、鍵やメールは、総務だけが把握し、鍵当番当日、本人へ直接メールで
案内しています。
「！」の記号に特にこだわりはありません。☆でも◎でもいいです。
当番を割り当てたあと、鍵とメール当番だけは手作業で別シートにうつす為、
総務が見落とさない様目印としてつけています。
誰が当番かはわからないようにしています。
・各自、ひと月当たり、何回くらい当番に当たるんですか？
５〜６ほどでしょうか。
電話の多い月はもう少し増えるかもしれません。
・質問文の「〇」が漢数字になっています。
失礼いたしました。記号の○です。
・ 産休って、月途中で職場復帰することはないのですか？
基本的に月初ですが、保育所などの関係でそうはいかない方も中にはおられます。
長らく休んで、月途中で復帰される場合は、その月の当番を割り当てておりません。
・会議は、月1回だけなんですか？
基本的にはそうです。ただ、そうでない場合もあります。
そういう場合も前もってわかっています。
・在宅期間は、月1回だけなんですか？
はい。在宅システムを設けていない部署（総務など）もあるため、
担当者リストに期間を書いたところだけ、シフト表に載せております。
・本人希望とか管理者希望で予め当番をきめることはあるか
ありません。
事情を聞き、やむを得ない場合、担当者リストの○印をはずすというような
ことはしたことがあります。
・早退や遅刻は当番に当たらない、と言う意味ですか
他の会社には、遅刻でも「午後の電話番」はやらせる、なんて所もあるらしいですが・・
早退や遅刻が申告通りとは限らないので、当番は当てておりません。
・組み合う相手はいつも同じにならない
これは何の当番における組み合わせの話なんですか？
電話以外の２人以上の組み合わせのときです。
（申し訳ありません。ゴミ当番も現在は２人体制でした）
いろんな方とコミュニケーションがとれるよう、
ランダムな組み合わせにしております。
・当番密度(？）が高くなりますよね。
この辺りはどう云う考えで(割り切りで)シフトを組んでいるのですか？
在宅は休暇者と同じ扱いにしていません。今月少なくなったとしても、
それはそれとし、その期間以外で調整し、少ない場合は電話当番を割り当てて
いました。
予定休をとられている方も、休みを考慮し、割り当てています。
平均値がなるべく同じになるようにしていました。
鍵・メール→役職クラスのみ
朝礼・ゴミ→課長クラスまで全員
車両・在庫→一般男子社員
給湯・郵便→一般女子社員
電話→役職クラスはAMかPMのみ
電話→平社員全員
というルールでリストに○を配置しています。
・先月のシフト表と社員リストはまだ残っていますね？
ありますが、上長が管理しており、フォルダを開くことができないのです。
（まっつん） 2023/12/06(水) 20:36:28
＞「！」がついているもの以外は新たにシフト表に 反映するようにしたい
上記はこれだけならコピーして貼り付ければいいので、
お願いしなくてもいいぐらいのものでした。
申し訳ありません。
（まっつん） 2023/12/06(水) 22:41:02
＞基本的に月初ですが、保育所などの関係でそうはいかない方も中にはおられます。 ＞長らく休んで、月途中で復帰される場合は、その月の当番を割り当てておりません。
結局、月途中から当番開始は可能性としては否定できないのですよね？
＞在宅は休暇者と同じ扱いにしていません。今月少なくなったとしても、 ＞それはそれとし、その期間以外で調整し、少ない場合は電話当番を割り当てていました。 ＞予定休をとられている方も、休みを考慮し、割り当てています。 ＞平均値がなるべく同じになるようにしていました。
ちょっとストレートに伝わって来ないのですが、在宅も連続休暇者も 何も無い人と同じ当番回数を目指す、と理解していいのですか？ ※「平均値」と言うのが何を意味するものなのか引っかかるのですが・・
＞鍵・メール→役職クラスのみ ＞・・ ＞電話→平社員全員 ＞というルールでリストに○を配置しています。
・・と言われましても、部外者には具体的な状況は分かりません。 「出社人数」行の直前までの社員に割り振るんですよね(→部長は当番なしと理解していますが）
＞＞・先月のシフト表と社員リストはまだ残っていますね？ ＞ありますが、上長が管理しており、フォルダを開くことができないのです。
実データに近いサンプルがないと、チューニングが出来ないです。 社員リストは、12月用を使えばいいです。（まさかこれにもアクセス出来ないって事はないですよね？） あとで、12月用の情報をお聞きすることになります。
シフト表の方は、もっともらしいサンプルをお作り頂くしかないです。 これも、あとでお聞きすることになります。(それ用マクロを作って吸い上げる予定)
※テスト用のデータがお互い共通であれば、話に行き違いがなくなります。
なお、社員リストの補足欄は以下のレイアウトに変更していただきます。(メモタイプのデータは扱いにくい為) データ型を文字列に設定し、単発日はカンマ区切り、期間はハイフン表示。(下例ご参照)
<社員リスト> 行 __J__ __K__ ____ L ____ __M__ __N__ 1 2 3 8 会議 在宅 産休 ・ ・ ・ 3 郵便 電話 4 PM 1-15 5 ○ 1-31 6 ○ 1,2 11-15 7 PM 8 ○ 4 9 ○ ○ 10 AM 1,2,5-10,30
（半平太） 2023/12/07(木) 09:36:19
バージョンは、Excel2021 で間違いないですね？ 実際にこれが影響するかは分かりませんが、確認します。
時々「会社のはもっと古かった、なんとかなりませんか」とか言われて手戻りになるようなことは避けたいので。
（半平太） 2023/12/07(木) 09:42:02
ご質問ありがとうございます。
解読ができないようなコメントをし、申し訳ありません。
・月途中から当番開始は可能性としては否定できないのですよね？
はい。
・在宅も連続休暇者も何も無い人と同じ当番回数を目指す、と理解していいのですか？
はい。
・ 「出社人数」行の直前までの社員に割り振るんですよね(→部長は当番なしと理解していますが）
はい。
・ あとで、12月用の情報をお聞きすることになります。
シフト表の方は、もっともらしいサンプルをお作り頂くしかないです。
上記の初めの方にあるものが、12月のものの一部になります。
どういったことを求められているのかがよくわかっておりません。
申し訳ありません。
社員数やどういった部署があるかなどは開示できないです・・・。
・社員リストの補足欄は以下のレイアウトに変更していただきます。
承知致しました。
・バージョンは、Excel2021 で間違いないですね？
はい。
（まっつん） 2023/12/07(木) 18:03:29
＞・在宅も連続休暇者も何も無い人と同じ当番回数を目指す、と理解していいのですか？ ＞はい。 そうですか・・、余り文句言わない社員さんが多いんですね。 以前、質問があった会社とは大違いです。
＞上記の初めの方にあるものが、12月のものの一部になります。 ＞どういったことを求められているのかがよくわかっておりません。 ＞申し訳ありません。 ＞社員数やどういった部署があるかなどは開示できないです・・・。
部署名は割振り方針に無関係なので、なくてもいいです。 と言うか、氏名も要りません。そもそも、そのデータは吸い上げません。
予定データ(D6セルからAH50位の範囲の「早退・遅刻・出張・・」のデータ）だけ吸い上げるつもりです。
社員数に関しては、およそ50名と聞いてますので、それに近い数の人が記入されていないとおかしい。 そんなに人数情報は秘匿姓が高いんでしょうか？(逆算して、どこの会社か分かっちゃう？）
※考えたら、12月はもう終わっているので、来年1月用でした。m(__)m
＞上記の初めの方にあるものが、12月のものの一部になります。 いや、一部じゃダメなんですよー。 旨く結果が出ないとか言われても、こちらで原因分析できないです。
こちらに吸い上げるときは、それ用のマクロをアップしますので、 それを実行していただければ、あとはコピペなので、そちらの手間はほとんどありませんが。。
（半平太） 2023/12/07(木) 19:24:15
上に同じ職場の人が見たらヒントになるようなものを
書いてしまったので、これ以上人数に関しても情報はお渡しできないのですが、
D6セルから1月分の早退・遅刻・出張などの
サンプル（ニセもの）データでしたら作ります。
行数に関しては50人程で増減することもありますので、
それぐらいの感じで作ります。
それでいいでしょうか？
（まっつん） 2023/12/07(木) 22:02:49
事情は分かりませんが、何か問題がありそうなので、無理強いは止めておきます。 ※取り敢えず、推測で作りますが、旨く行かないと言われても、こちらは対応しません。
条件が複雑なので、少し時間が掛かります。
＞上に同じ職場の人が見たらヒントになるようなものを ＞書いてしまったので、 ・・であるなら、その部分は今すぐ、ここ経由で消してください。 ↓ https://www.excel.studio-kazu.jp/wiki/excelboard/edit.html
やり方が分からなければ、 「何日何時にアップしたどの部分か」言って貰えればこちらで削除します。
（半平太） 2023/12/07(木) 22:41:05
ありがとうございます。
・取り敢えず、推測で作りますが、旨く行かないと言われても、こちらは対応しません。
承知致しました。
複雑なものを、時間をかけ考えてくださるだけでも、大変感謝しております。
アップしたものの対処方法もアドバイス下さりありがとうございます。
（まっつん） 2023/12/08(金) 08:06:41
＞55 出社人数 ＞56 早 ＞57 遅 ＞58 休
出社人数を出す前提として、早・遅・休の数を集計するんでしょうが、 それ以外にも、出張、産休、会議、在宅の数も影響しますよね？
それらの集計はどう取り扱うんですか？ 正しい出社人数さえ出れば、内訳は気にしないってことなんでしょうか？
（半平太） 2023/12/09(土) 20:48:04
ありがとうございます。
詳しくご説明しておりませんでした。申し訳ありません。
このシフト表こある「早」「遅」「休」は、朝礼当番が把握する為や
メール送信する際などに必要としております。
産休の場合や入院などの長期の休暇をとられる方は、初日だけ朝礼のときにお知らせし、
あとは連絡しないので、内訳は必要としていません。
出社人数は純粋に「仕事をしない方」を表示させたいのです。
ですから、産休や入院の方も「仕事をしない方」に入ります。
出張、会議、在宅は仕事をしているためカウントします。
よろしくお願いします。
（まっつん） 2023/12/09(土) 21:18:10
↑上記間違えました
出社人数は純粋に「出社している方」を表示させたいのです。
の間違いでした。
（まっつん） 2023/12/09(土) 21:56:42
＞出社人数は純粋に「出社している方」を表示させたいのです。
部外者にはどう言う判定なのか分からないです。
誰を出社と判定するのか？ もしくは、名前の総数から、誰を引くのか？
そんな観点で、正しくカウントできる方法をご説明ください。
こちらは、部長でさえ、出社数に入れるのか否かも自信持てないです。
（半平太） 2023/12/09(土) 22:31:36
ありがとうございます。
・シフト表にある「出社人数」より上の人数を名前で総カウント。
（部長はカウントしない。）
・社員リスト補足に、「産休」＆「長期療養者(入院など）」の欄に数字のある方は
シフト表はグレーアウト＆出社人数からは引く。
早・遅・休も引く。
どうぞよろしくお願い致します。
（まっつん） 2023/12/10(日) 08:10:26
＞ 朝礼＝セルの色がオレンジ ＞ ゴミ＝セルの色が黄色 ＞ 車両＝セルの色が茶色 ＞ 給湯＝セルの色が薄ピンク ＞ 郵便＝「〒」の文字 ＞ 電話＝水色と「AM」や「PM」の文字
シフト表は、ほとんど色付けだけで、 文字も一緒に出すのは 「〒」「AM」「PM」 の3種類だけとの理解でいいですか？
※電話は、名入りの別表も作る。
（半平太） 2023/12/10(日) 12:50:04
ご質問ありがとうございます。
当番が沢山あるため、色付けで表示しています。
文字があるのは「〒」「AM」「PM」で、ご理解いただいている通りですが、
郵便はカラーなしです。
電話の別表の件も、ありがとうございます！
（まっつん） 2023/12/10(日) 17:58:02
１．社員リストは以下の形式とします。
行 __K__ __L__ __M__ ___N___ _____O_____ 2 8 会議 在宅 産休 長期療養者 3 電話 4 ○ 1 5 ○ 1-31 6 ○ 1-8 7 ○ 11-15 8 AM 4 9 ○ 1-31 10 ○ 11 PM 5.9 2,4-6,9
２．祝日データ範囲は、「祝日リスト」と名前定義してあるものとします。 日付データ範囲及び未入力セル範囲とし、当該範囲内に文字データは無いもの(元日とか）。
３．実行は、マクロ「Main」を実行するか、シフト表の1行目のどこかしらを右クリックする。 通常は、満足のいくシフト表が出来るまで、シフト表の1行目を何回か右クリックすることになる。
４．もし、出力結果を消して、元の手入力状態に戻したい場合は、マクロ「resetOriginal」を実行する。 単に、数式を消すだけですけども。
５．作業シートと電話シートは、自動的に挿入されます。
６．使用するマクロは以下の3か所に分けてコピペする
(1)クラスモジュールを一枚挿入して、クラス名(オブジェクト名）を変更する。 Class1 → Staff 当該モジュールに後記のクラスモジュール用のプログラムをコピペする。
(2）シフト表のモジュール(重要：標準モジュールではない）に後記の シートモジュール用のプロシージャをコピペする
(３）標準モジュールに後記の 標準モジュール用のプログラムをコピペする
７．マクロコード (1)------------------ クラス staff用---------------------------------------------- Option Explicit
Private Idx As Long
Private OwnName As String
'Private rOwnRW As Range '書式が関わるシフト表の場合に必要
Private vOwnRW As Variant '進行中データ管理用
Private vOwnRWOUT As Variant '打出し用(結果を数式の文字列で出す）
Private timesDone() As Long '(優先当番種順に実行回数、最後は合計回数が入る)
Private randomPos As Long 'シャッフルを入れる場合の順番
Private ableDuties As String '担当可リスト
Private NGdays(1 To 31) As Boolean
Private GreyedMatn(1 To 31) As Boolean
Private GreyedMedi(1 To 31) As Boolean
Private dutyPrevDone As String '電話以外でやった前回当番
Sub init(i As Long, rSftDupl As Range, vNameAry, wsMast As Worksheet, rDutyList As Range, vDutyList, rInconvDays As Range, CvT, RdAry())
Dim dty As Range, temp As String
Dim Incv, Details, NN As Long, kk As Long
Dim mastIdx
ReDim timesDone(1 To UBound(vDutyList)) As Long '最後の電話は2つに分れている(要注意)
ReDim combCPbyDuty(1 To UBound(vDutyList)) As String
Idx = i
OwnName = vNameAry(i, 1)
'社員リストの氏名順番がシフト表のとは異なる可能性があるので、行位置を求める。
mastIdx = CvT(Idx)
'Set rOwnRW = rSftDupl.Rows(i)
vOwnRW = rSftDupl.Rows(i).Value
vOwnRWOUT = rSftDupl.Rows(i).Value
randomPos = RdAry(i) 'テスト時は乱数は使用しない
For Each dty In rDutyList '社員リスト!$C$3:$K$3
If dty(mastIdx + 1, 1) <> "" Then '社員が担当可能かチェック
temp = dty.Value '当番名を取得
If dty = "電話" Then '電話は2つに分割する
If dty(mastIdx + 1, 1) = "AM" Then
temp = "電話AM"
ElseIf dty(mastIdx + 1, 1) = "PM" Then
temp = "電話PM"
Else
temp = "電話AM,電話PM" '○の場合は両方
End If
End If
ableDuties = ableDuties & "," & temp
End If
Next dty
ableDuties = ableDuties & ","
Incv = Application.Index(rInconvDays.Rows(mastIdx).Value, 0, 0)
Incv = Join(Incv, ",")
Incv = Split(Incv, ",") '一旦結合してから、再分割
For NN = 0 To UBound(Incv)
Details = Split(Incv(NN) & "-", "-")
If UBound(Details) = 1 Then
If Details(0) <> "" Then
NGdays(Details(0)) = True
End If
Else
For kk = Details(0) To Details(1)
NGdays(kk) = True
Next kk
End If
Next NN
'グレーアウト判定 項目名が産休or長期療養
Dim aCol As Range
Dim Knd(1 To 2)
For Each aCol In rInconvDays.Columns
Knd(1) = InStr(aCol.Cells(-1, 1), "産休")
Knd(2) = InStr(aCol.Cells(-1, 1), "長期療養")
If Knd(1) Or Knd(2) Then
If aCol.Cells(mastIdx, 1) <> "" Then
Incv = Split(aCol.Cells(mastIdx, 1) & ",", ",")
For NN = 0 To UBound(Incv)
Details = Split(Incv(NN) & "-", "-")
If UBound(Details) = 1 Then
If Details(0) <> "" Then
If Knd(1) Then
GreyedMatn(Details(0)) = True
Else
GreyedMedi(Details(0)) = True
End If
End If
Else
For kk = Details(0) To Details(1)
If Knd(1) Then
GreyedMatn(kk) = True
Else
GreyedMedi(kk) = True
End If
Next kk
End If
Next NN
End If
End If
Next aCol
End Sub
'既にコンビとなった事があるかチェック
Function sameFace(Duty, ColNum As Long, fixedComb(), vSftDupl) As Boolean
Dim P As Long, CL As Long
If Left(Duty, 2) = "電話" Then
Exit Function
Else
For P = 1 To UBound(fixedComb) - 1
If fixedComb(P) <> Idx And fixedComb(P) <> Empty Then '他人なら処理
For CL = 11 To ColNum
If vOwnRW(1, CL) = Duty Then
If vSftDupl(fixedComb(P), CL) = Duty Then
sameFace = True
GoTo wayOut
End If
End If
Next
End If
Next P
End If
wayOut:
End Function
'優先順位作成
Function Priority(Duty, DutyPos As Long, ColNum As Long, vDays, AllDuties, staffs() As staff, fixedComb(), vSftDupl)
Dim dy As Date
Dim i As Long
Dim ck(1 To 2)
Dim Top(1 To 6) As String
'top(1)-----------------------------------
dy = vDays(1, ColNum) '処理対象日付
Dim PreAft(1 To 3, 1 To 2) '前後3営業日以内の当番名を取得する。
For i = 1 To 3
PreAft(i, 1) = vOwnRW(1, getPreCol(dy, -i, ColNum)) 'Colnum←処理対象列番
PreAft(i, 2) = vOwnRW(1, getPreCol(dy, i, ColNum)) 'Colnum←処理対象列番
Next
Top(1) = "A" '仮置き
If vOwnRW(1, ColNum) <> "" Then '休、指定済、既決定
Top(1) = "Z"
ElseIf InStr(ableDuties, Duty) = 0 Then '担当不可
Top(1) = "Z"
ElseIf NGdays(ColNum - 10) Then '不可日 (列番より10小さい位置に不可判定の真偽値がある）
Top(1) = "Z"
ElseIf Duty = dutyPrevDone And Left(Duty, 2) <> "電話" Then
Top(1) = "T"
ElseIf Duty = "ゴミ" Then '朝礼とゴミは最低2日間あける
For i = 1 To 2
If InStr(Duty & PreAft(i, 1) & Duty, "朝礼ゴミ") Or _
InStr(Duty & PreAft(i, 2) & Duty, "朝礼ゴミ") Then
Top(1) = "W" 'ツーランクハードルを上げる
Exit For
End If
Next i
ElseIf sameFace(Duty, ColNum, fixedComb(), vSftDupl) Then ' '同じ顔合わせ
Top(1) = "U"
Else
'前後3日間以内の当番有無をチェック
For i = 1 To 3
ck(1) = vOwnRW(1, getPreCol(dy, -i, ColNum)) 'Colnum←処理対象列番
ck(2) = vOwnRW(1, getPreCol(dy, i, ColNum)) 'Colnum←処理対象列番
If InStr(AllDuties, ck(1)) Or InStr(AllDuties, ck(2)) Then
Top(1) = Mid("PNL", i, 1)
Exit For
End If
Next
End If
'top(2)-----------------------------------
Top(2) = Format(Val(timesDone(DutyPos)), "00") '当該当番の回数
''top(3)-----------------------------------
'同じ顔合わせは難度を引き上げる(2)--------------------------
If sameFace(Duty, ColNum, fixedComb(), vSftDupl) Then
Top(3) = "G" 'ハードルを上げる
Else
Top(3) = "A" '標準
End If
'top(4)(5)(6)----------------------------------
Top(4) = Format(ttlDone, "00") 'トータル回数
Top(5) = Format(randomPos, "00") 'ランダム順
Top(6) = Format(Idx, "00") '行番号、インスタンスNO
'
Priority = Join(Top, "")
End Function
Sub asignDuty(Duty, DutyPos As Long, ColNum As Long)
timesDone(DutyPos) = timesDone(DutyPos) + 1
timesDone(UBound(timesDone)) = timesDone(UBound(timesDone)) + 1 '総計
vOwnRW(1, ColNum) = Duty
vOwnRWOUT(1, ColNum) = "=""" & Duty & """" '数式の形にする(手入力と区別する為)
If Left(Duty, 2) <> "電話" Then '電話でなければ、最新当番名を記憶
dutyPrevDone = Duty
Else
dutyPrevDone = ""
End If
End Sub
Function Name()
Name = OwnName
End Function
Function result(ColNum As Long)
result = vOwnRWOUT(1, ColNum)
End Function
'
Function ttlDone()
ttlDone = timesDone(UBound(timesDone))
End Function
Sub reflectNoShow(ByRef 非出社() As Long)
Dim CL As Long
For CL = 1 To 31
If GreyedMatn(CL) Then
非出社(1, CL) = 非出社(1, CL) + 1
End If
If GreyedMedi(CL) Then
非出社(2, CL) = 非出社(2, CL) + 1
End If
Next CL
End Sub
Sub offDuty(target As Range, ColNum As Long)
If GreyedMatn(ColNum) Then
target.Interior.Color = RGB(211, 211, 211)
End If
If GreyedMedi(ColNum) Then
target.Interior.Color = RGB(211, 211, 211)
End If
End Sub
’(2)------------------ シフト表モジュール用----------------------------- Option Explicit
Private staffs() As staff
'実行方法：Mainを実行するか、シフト表の1行目のどこかを右クリックする
Sub Main()
Call dutyAssign
End Sub
Private Sub Worksheet_BeforeRightClick(ByVal target As Range, Cancel As Boolean)
If target.Row = 1 Then
Cancel = True
Call dutyAssign
End If
End Sub
Private Sub dutyAssign()
Dim wsMast As Worksheet
Dim wsWork As Worksheet
Dim wsTel As Worksheet
Dim orgName As Range, orgDay As Range, orgSft As Range
Dim dupName As Range, dupDay As Range, dupSft As Range
Dim Duty '当番名
Dim AllDuties '全当番名結合
Dim lastRw As Long
Dim dy As Date
Dim rHldy As Range
Dim msgAlert As String
Dim SrtLst As Object
Dim rDutyList As Range
Dim vDutyList
Dim rDutyTimes As Range
Dim vDutyTimes
Dim staffTTL As Long
Dim vNameAry
Dim RdAry()
Dim Trial
Dim rSftDupl As Range
Dim vSftDupl
Dim vDays
Dim ColNum As Long
Dim CL As Long
Dim Idx As Long
Dim priotryKey
Dim rLastDuty As Range, rInconvDays As Range
Dim convertTbl
Dim DutyPos As Long
Dim innerCnt As Long
Dim fixedComb() As Variant
Dim 非出社() As Long
Call addWorksheetIfMissing("作業") '作業シートを挿入(無い場合)
Call addWorksheetIfMissing("電話") '電話シートを挿入(無い場合)
Set wsWork = Worksheets("作業")
Set rHldy = Application.Range("祝日リスト")
Set wsMast = Worksheets("社員リスト")
Set wsTel = Worksheets("電話")
Set SrtLst = CreateObject("System.Collections.SortedList")
Set orgName = Range("C8")
Set orgSft = Range("D8")
Set orgDay = Range("D6")
With wsWork
Set dupName = .Range("A2")
Set dupSft = .Range("K2")
Set dupDay = .Range("K1")
End With
lastRw = orgName.Offset(0, -1).EntireColumn.Find("出社人数").Row - 1 '名前列の最終行番号(出社人数の1行上)
staffTTL = lastRw - orgName.Row + 1 'スタッフの数
Range("B8:B" & lastRw).Resize(staffTTL, 1).ClearContents
Range("B8").Formula2 = "=XLOOKUP(C8:C" & lastRw & ",社員リスト!A:A,社員リスト!B:B,"""")"
vNameAry = orgName.Resize(staffTTL, 1).Value
With wsMast '「電話」は当番の最終列に記入してあるものとする(必須)
Set rLastDuty = .Rows(3).Find("電話", , xlValues, , , xlPrevious)
Set rDutyList = .Range("C3", rLastDuty)
vDutyList = Application.Index(rDutyList.Value, 1, 0)
AllDuties = Join(vDutyList, ",") ''電話は午前・午後に分ける
AllDuties = Replace(AllDuties, "電話", "電話AM,電話PM")
ReDim Preserve vDutyList(1 To UBound(vDutyList) + 1) '電話は午前・午後に分ける
vDutyList(UBound(vDutyList) - 1) = "電話AM"
vDutyList(UBound(vDutyList)) = "電話PM"
Set rDutyTimes = .Range("C3", rLastDuty).Offset(-1)
vDutyTimes = Application.Index(rDutyTimes.Value, 1, 0)
ReDim Preserve vDutyTimes(1 To UBound(vDutyTimes) + 1)
vDutyTimes(UBound(vDutyTimes) - 1) = vDutyTimes(UBound(vDutyTimes) - 1) / 2
vDutyTimes(UBound(vDutyTimes)) = vDutyTimes(UBound(vDutyTimes) - 1)
'不在日範囲の処理(項目：会議、在宅、産休、長期療養・・・）
Set rInconvDays = .Range(rLastDuty.Offset(-1, 1), .Cells(2, Columns.Count).End(xlToLeft))
'不在日の実データ範囲
Set rInconvDays = rInconvDays.Offset(2).Resize(staffTTL, rInconvDays.Columns.Count)
End With
If lastRw >= 100 Then
MsgBox "シフト表の最下行は100未満を想定しています"
Exit Sub
End If
Rem シフト表シートでの処理-------------------------
Call resetOriginal(orgSft, staffTTL) 'シフト表枠をオリジナルに戻す(数式をクリア)
'シフト表の日付行とスケジュール行を作業シートへ転記
wsWork.UsedRange.ClearContents
orgDay.Resize(1, 31).Copy 'K1行目以降に日付行をコピペ
dupDay.PasteSpecial xlPasteValuesAndNumberFormats
orgSft.Resize(staffTTL, 31).Copy dupSft 'K2行目以降に実データをコピぺ
' '作業シートでの処理-------------------------
'
For Trial = 1 To 1 'トライアル回数
SrtLst.Clear
Erase staffs
RdAry = rndOrder(lastRw) '乱数生成
Call resetDuplicate(dupSft, staffTTL) '作業シートを元に戻す(数式クリア)
vDays = wsWork.Range("A1:AY1").Value '日付行範囲値(なお、初日はK列から)
Set rSftDupl = wsWork.Range("A2:AY2").Resize(staffTTL) 'シフト実データ範囲値(初日はK列)
vSftDupl = rSftDupl.Value 'シフト関連データ範囲値(初日はK列)
With Application 'シフト表と社員リストの対応表
convertTbl = .Transpose(.XMatch(orgName.Resize(staffTTL), wsMast.Range("A4:A100"), 0))
If .Count(convertTbl) < staffTTL Then
MsgBox "社員リストに見当たらない人がいます。処理中止"
Exit Sub
End If
End With
'staffインスタンス作成
ReDim staffs(1 To staffTTL)
ReDim 非出社(1 To 2, 1 To 31) '上段：産休、下段:長期療養 事前集計
For CL = 1 To staffTTL
Set staffs(CL) = New staff
staffs(CL).init CL, rSftDupl, vNameAry, wsMast, rDutyList, vDutyList, rInconvDays, convertTbl, RdAry
'産休・長期療養の人数を把握しておく（出社人数の計算に必要）
staffs(CL).reflectNoShow 非出社
Next CL
'割当本番(作業シート上で処理）
DutyPos = 0
For Each Duty In vDutyList '重要な当番から決めて行く
DutyPos = DutyPos + 1
For ColNum = 11 To 41 '当番順＞各列毎に決定(K列から処理)
dy = IIf(vDays(1, ColNum) = "", 0, vDays(1, ColNum)) '1列目の日付を取得(空白文字列対策要)
If Application.NetworkDays(dy, dy, rHldy) Then '営業日のみ処理
ReDim fixedComb(1 To vDutyTimes(DutyPos))
For innerCnt = 1 To vDutyTimes(DutyPos)
SrtLst.Clear
For Idx = 1 To staffTTL '通常処理(=staffの1番目から） 優先キーを登録
SrtLst.Add staffs(Idx).Priority(Duty, DutyPos, ColNum, vDays, AllDuties, staffs, fixedComb, vSftDupl), Empty
Next Idx
priotryKey = SrtLst.Getkey(0) '最優先のStaffを取り出す。
If Left(priotryKey, 1) <> "Z" Then '割当決定
Idx = Val(Right(priotryKey, 2)) '決定Idx
staffs(Idx).asignDuty Duty, DutyPos, ColNum
vSftDupl(Idx, ColNum) = Duty 'マトリックスに書き込み
fixedComb(innerCnt) = Idx
Else
msgAlert = msgAlert & ColNum & "列目の" & Duty & "が割当できません" & vbCrLf
Exit For
End If
Next innerCnt '2個目、3個目処理へ
End If
skipThisDay:
Next ColNum
Next Duty
SrtLst.Clear
Next Trial
rSftDupl.Value = vSftDupl '結果を作業表に反映
showResult staffs, wsWork, 非出社, orgSft, staffTTL
Cells(lastRw + 2, "D").Resize(3, 31).Formula = _
"=IF(D$6="""","""",IF(NETWORKDAYS(D$6,D$6,祝日リスト)=0,"""",COUNTIF(D$8:D$" & lastRw & ",$B" & lastRw + 2 & ")))"
Cells(lastRw + 1, "D").Resize(1, 31).Formula = _
"=IF(D$6="""","""",IF(NETWORKDAYS(D$6,D$6,祝日リスト)=0,"""",COUNTA($C8:$C" & lastRw & ")-SUM(D56:D58)-SUM(作業!K101:K102)))"
電話当番表作成 vSftDupl, vDays, vNameAry, wsTel
Erase staffs()
Application.ScreenUpdating = True
If msgAlert <> "" Then
MsgBox msgAlert
End If
End Sub
Sub 元に戻す()
Dim lastRw As Long
lastRw = Columns("C").Find("出社人数").Row - 1 '名前列の最終行番号(出社人数の1行上)
resetOriginal Range("D8"), lastRw - 7
End Sub
'元に戻す関連(始)------------------------
Private Sub resetOriginal(TopLeft As Range, rowsToClear As Long) 'シフト表を元に戻す
clearFormula Worksheets("シフト表"), TopLeft, rowsToClear
End Sub
Private Sub resetDuplicate(TopLeft As Range, rowsToClear As Long) '作業シートを元に戻す
clearFormula Worksheets("作業"), TopLeft, rowsToClear
End Sub
Private Sub clearFormula(Ws As Worksheet, TopLeft As Range, rowsToClear As Long) '(数式を消す)
With Ws
On Error Resume Next
TopLeft.Resize(rowsToClear, 31).SpecialCells(xlCellTypeFormulas, 23).ClearContents
On Error GoTo 0
End With
End Sub
'元に戻す関連(終)------------------------
Private Sub showContents(SrtLst As Object, wsWork As Worksheet)
Dim CL As Long
For CL = 0 To SrtLst.Count - 1
wsWork.Cells(CL + 2, "B").Value = SrtLst.Getkey(CL)
Next CL
End Sub
Private Sub showResult(staff() As staff, wsWork As Worksheet, 非出社() As Long, orgSft As Range, staffTTL)
Dim Idx As Long
Dim ColNum As Long
Dim aryOut()
ReDim aryOut(1 To UBound(staffs), 1 To 31)
orgSft.Resize(staffTTL, 31).Interior.Pattern = xlNone
For ColNum = 1 To 31
For Idx = 1 To UBound(staffs)
'産休・長期療養をクレーアウト
staff(Idx).offDuty orgSft(Idx, ColNum), ColNum
If staffs(Idx).result(ColNum + 10) <> "" Then
Select Case staffs(Idx).result(ColNum + 10)
Case "=""朝礼""": orgSft(Idx, ColNum).Interior.Color = RGB(255, 165, 0) 'オレンジ
Case "=""ゴミ""": orgSft(Idx, ColNum).Interior.Color = RGB(255, 255, 0) '黄色"
Case "=""車両""": orgSft(Idx, ColNum).Interior.Color = RGB(165, 42, 42) '茶色"
Case "=""給湯""": orgSft(Idx, ColNum).Interior.Color = RGB(255, 240, 245) '薄ピンク
Case "=""郵便""": orgSft(Idx, ColNum).Value = "=""〒""" '＝「〒」の文字"
Case "=""電話AM"""
orgSft(Idx, ColNum).Interior.Color = RGB(0, 255, 255) '水色と「AM」
orgSft(Idx, ColNum).Value = "=""AM"""
Case "=""電話PM"""
orgSft(Idx, ColNum).Interior.Color = RGB(0, 255, 255) '水色と「PM」
orgSft(Idx, ColNum).Value = "=""PM"""
Case Else: orgSft(Idx, ColNum).Value = staffs(Idx).result(ColNum + 10)
End Select
End If
'aryOut(Idx, ColNum) = staffs(Idx).result(ColNum + 10)
Next Idx
Next ColNum
' Range("D8").Resize(UBound(staffs), 31).FormulaLocal = aryOut
wsWork.Range("K101").Resize(2, 31).Value = 非出社
End Sub
Sub 電話当番表作成(vSftDupl, vDays, vNameAry, wsTel As Worksheet)
Dim dicT As Object
Dim telCnt(1 To 2)
Dim CL As Long, Idx As Long
Dim temp(1 To 8)
Set dicT = CreateObject("Scripting.Dictionary")
For CL = 11 To 41
Erase temp
Erase telCnt
dicT(vDays(1, CL)) = temp
For Idx = 1 To UBound(vSftDupl)
If vSftDupl(Idx, CL) = "電話AM" Then
telCnt(1) = telCnt(1) + 1
temp(telCnt(1)) = vNameAry(Idx, 1)
dicT(vDays(1, CL)) = temp
ElseIf vSftDupl(Idx, CL) = "電話PM" Then
telCnt(2) = telCnt(2) + 1
temp(telCnt(2) + 4) = vNameAry(Idx, 1)
dicT(vDays(1, CL)) = temp
End If
Next Idx
Next CL
wsTel.UsedRange.Offset(1).Resize(, 9).ClearContents
wsTel.Range("A2").Resize(dicT.Count) = Application.Transpose(dicT.keys)
wsTel.Range("B2:I2").Resize(dicT.Count) = Application.Index(dicT.items, 0, 0)
dicT.RemoveAll
End Sub
’(3)------------------ 標準モジュール用-----------------------------
'シート名を指定して、追加する(存在しないケース）
Sub addWorksheetIfMissing(wsName As String)
Dim wsTest As Worksheet
On Error Resume Next
Set wsTest = Worksheets(wsName)
If Err.Number <> 0 Then
ThisWorkbook.Worksheets.Add.Name = wsName
End If
On Error GoTo 0
End Sub
'ある日付の列からの指定営業日数前の日が何列目なのか割り出す(前はマイナス値を入力)
'使用例：debug.print getPreCol(#11/1/2023#, -2, 5)
Function getPreCol(baseDay As Date, beforeAfter As Long, baseColNum As Long) As Long
Dim rHldy As Range
Dim busiDay
Set rHldy = Application.Range("祝日リスト")
busiDay = Application.WorkDay(baseDay, beforeAfter, rHldy)
getPreCol = CLng(baseColNum + busiDay - baseDay)
getPreCol = Application.Max(1, getPreCol) 'ゴールデンウィーク対策
getPreCol = Application.Min(51, getPreCol)
End Function
Function rndOrder(num As Long) '乱数生成(個数分)
Dim rd(), orderNum(), i, rndInOrder
Randomize
ReDim re(1 To num)
ReDim orderNum(1 To num)
For i = 1 To num
orderNum(i) = i
re(i) = Rnd()
Next i
rndInOrder = Application.Small(re, orderNum)
rndOrder = Application.Match(re, rndInOrder, 0)
End Function
（半平太） 2023/12/10(日) 20:10:12 -後日修正 2023/12/11(日) 10:18:00
ありがとうございます。
このようにすごいものを、想定外な期間で作られたことに
本当にびっくりです。
貴重な時間を割いて考えてくださったので、
早速試してみました。
実行時エラー 91
オブジェクト変数またはWithブロック変数が設定されていません。
と、メッセージが表示され
lastRw = orgName.EntireColumn.Find("出社人数").Row - 1 '名前列の最終行番号（出社人数の1行上）
が黄色に反転しております。
私のマクロの貼り付け方が間違っていたのでしょうか。
修正方法を教えてください。よろしくお願い致します。
（まっつん） 2023/12/10(日) 23:13:19
イミディエイトウィンドウに以下を打ち込むと、なんと出ますか？
? orgName.Address(,,,true)
[ブック名]シフト表!$C$8 と出るハズなんですが。
そう出たとして、C列に「出社人数」と言うセルはありますか？
（半平太） 2023/12/10(日) 23:38:18
実行時エラー 424
オブジェクトが必要です。
とエラーが表示されました。
「出社人数」はC列ではなく、B列にあるのですが、
C列に変更し、
再度実行しても変化ありませんでした。
お手数をおかけいたします。
（まっつん） 2023/12/11(月) 06:35:36
もう一度貼り付け直し、
再度実行をかけたところ、
For Idx = 1 To staffTTL '通常処理(=staffの1番目から） 優先キーを登録 →SrtLst.Add staffs(Idx).Priority(Duty, DutyPos, ColNum, vDays, AllDuties, staffs, fixedComb, vSftDupl), Empty
→部分が黄色に反転し、
実行時エラー13
型が一致しません
とエラーがでました。
イミディエイトウィンドウに入力したものも、
先ほどのオブジェクトが必要です。のままでした。
（まっつん） 2023/12/11(月) 06:46:03
＞「出社人数」はC列ではなく、B列にあるのですが、C列に変更し、 ＞再度実行しても変化ありませんでした。
あれれ、レイアウトを間違えてしまいました。 m(__)m
本来のB列に「出社人数」「早・遅・休」を戻してください。
2023/12/10(日) 20:10:12にアップした(1)、(2)のコード(staff用とシフト表用）を上書き修正しましたので、 お手数ですが、入替をお願いします。
(3)の標準モジュール用はそのままです。
（半平太） 2023/12/11(月) 10:19:40
ご連絡ありがとうございます。
・本来のB列に「出社人数」「早・遅・休」を戻してください。
直しました。
・ (1)、(2)のコード(staff用とシフト表用）の入替をお願いします。
修正致しました。
再度実行をかけたところ、
今朝と同じで
For Idx = 1 To staffTTL '通常処理(=staffの1番目から） 優先キーを登録 →SrtLst.Add staffs(Idx).Priority(Duty, DutyPos, ColNum, vDays, AllDuties, staffs, fixedComb, vSftDupl), Empty
→部分が黄色に反転し、
実行時エラー13
型が一致しません
とシフト表コードで、エラーがでました。
お手数をおかけし申し訳ありませんが、
再度修正方法を教えてください。
イミディエイトウインドウに、教えていただいたコードを入力したところ、
シフト表!$C$8
と、問題なく表示されました。
（まっつん） 2023/12/11(月) 17:48:09
＞ For Idx = 1 To staffTTL '通常処理(=staffの1番目から） 優先キーを登録 ＞→SrtLst.Add staffs(Idx).Priority(Duty, DutyPos, ColNum, vDays, AllDuties, staffs, fixedComb, vSftDupl), Empty ＞→部分が黄色に反転し、 ＞実行時エラー13 ＞型が一致しません
こちらでは問題が起きないので、分かりません。
黄色に反転した時、カーソルをIdxに近づけてみて、数値が何になっているか教えてください。
（半平太） 2023/12/11(月) 19:03:11
Idx=1
と表示されていました。
（まっつん） 2023/12/11(月) 20:45:10
初っ端から問題があるらしいですね。
＞ For Idx = 1 To staffTTL '通常処理(=staffの1番目から） 優先キーを登録
その文の真上に下記のコードを挿入して、普通にマクロを実行すると、そこでストップしますが、 イミディエイトウィンドウに何が出たか教えてください。
※以上のテストが終わったら、元に戻してください(＝消す）
こんなのが出ると予想していますが、途中でエラーになるかも知れません。(その場合はその状況を教えてください) ↓ ！鍵 1 11 2023/12/01 ！鍵,朝礼,ゴミ,車両,在庫,給湯,！ﾒｰﾙ,郵便,電話AM,電話PM 47 ## 47
’挿入するテストコード ' ↓ '一時的に内訳を打ち出す Debug.Print Duty Debug.Print DutyPos Debug.Print ColNum Debug.Print vDays(1, 11) Debug.Print AllDuties Debug.Print UBound(staffs) Debug.Print "#" & fixedComb(1) & "#" Debug.Print UBound(vSftDupl) Stop
（半平太） 2023/12/11(月) 21:16:46
イミディエイトウィンドウには
下のように出ました。
1 !鍵,朝礼,ゴミ,車両,在庫,給湯,!メール,郵便,電話AM,電話PM 50 ## 50
どうでしょうか。
よろしくお願いします。
（まっつん） 2023/12/11(月) 22:13:28
すみません。上記のコピーは途中からでした。
イミディエイトウィンドウに、表示されているものは
下記のようにでました。
!鍵
1 12 1 !鍵,朝礼,ゴミ,車両,在庫,給湯,!メール,郵便,電話AM,電話PM 50 ## 50
よろしくお願いします。
（まっつん） 2023/12/11(月) 22:20:47
全角と半角の違いかと思い、訂正しましたが、
同じところでエラーがでました。
（まっつん） 2023/12/11(月) 22:58:21
日付データが見当たらないですねぇ。。
「D6セルに初日」が入っていますか？ 例：2023/12/1
まさか、ただの「1」じゃないですよね？
＞シフト表は https://www.youtube.com/watch?v=X7yHIMyVX1s&list=PLauuFlD7eyY0SIyY8WnrEmgIg45vGc1xx&index=7 ＞を元に作成しております。 ↑ だったハズですが・・
（半平太） 2023/12/11(月) 23:13:37
確認したところ、そのまさかでした。
申し訳ありません・・・。
日付を修正し、再度実行したところ、
うまく出来ました！！！
電話帳も表示され、感動しました。
複雑な問題だったと思いますが、
こんなに短期間で解決してくださり、
本当にありがとうございます！！
（まっつん） 2023/12/12(火) 19:11:07
一つ質問です。
作業シートは左の方が空白になっていますが、
これは何か意図があるのでしょうか。
（まっつん） 2023/12/12(火) 20:26:58
ある日、なにがしかの当番になれるかどうかを考える上で、 その日の何営業日前に何の当番に当たっているかとか、 誰と組んだかとか調べないとならないですが、 そのある日が初日とか2日目だったら、 そもそも2営業日前なんてデータは存在しないので困っちゃいます。
そんなイレギュラーな事態に、いちいち真面目に分岐処理をしていては面倒なので たとえ空白でも10カレンダー日を左側に用意しておけば普通処理で済ませられると言うことからです。
（半平太） 2023/12/12(火) 20:58:10
詳しくご説明下さり、ありがとうございます。
そういうことなのですね。
本当によくわかりました。
いろんな考え方をしてくださったのですね。
複雑な内容を理解して下さり、
マクロもわかりやすいように、
丁寧に言葉を入れていただき、ありがとうございます。
（まっつん） 2023/12/12(火) 21:59:24
!鍵当番についてですが、当番ができる人数が５名で、
平日が５日なので、毎週同じ曜日に割り当てられます。
これを回避する方法はないでしょうか。
よろしくお願い致します。
（まっつん） 2023/12/13(水) 22:20:49
リセットをかけようとしたところ、
オブジェクト変数またはWithブロック変数が設定されていません。
とエラーがかかりました。
修正方法を教えていただけますでしょうか。
よろしくお願い致します。
（まっつん） 2023/12/13(水) 22:30:03
＞毎週同じ曜日に割り当てられます。
そうなんですか。 確信はないですが、以下の修正をしてみてください。
１．シフト表モジュール用の中 ＞ If Application.NetworkDays(dy, dy, rHldy) Then '営業日のみ処理 ＞ ReDim fixedComb(1 To vDutyTimes(DutyPos))
上の2行の下に、以下4行を挿入
RdAry = rndOrder(lastRw) '乱数生成
For CL = 1 To staffTTL
staffs(CL).setRandOrderEveryDay RdAry
Next CL
２．staffモジュール用に以下のメソッドを追加。 場所はどこでもいいですが、最後尾にでも。
Sub setRandOrderEveryDay(RdAry)
randomPos = RdAry(Idx)
End Sub
＞リセットをかけようとしたところ、 ＞オブジェクト変数またはWithブロック変数が設定されていません。
具体的にどの行で発生しましたか？
（半平太） 2023/12/13(水) 23:16:01
早速のお返事ありがとうございます。
１．同じ曜日に割り当てられていた当番ですが、
回避できました。
ありがとうございます！
２．シフト表コード
Sub 元に戻す()
Dim lastRw As Long
→ lastRw = Columns("C").Find("出社人数").Row - 1 '名前列の最終行番号(出社人数の1行上)
resetOriginal Range("D8"), lastRw - 7
End Sub
矢印の箇所で黄色に反転しております。
よろしくお願い致します。
（まっつん） 2023/12/13(水) 23:47:51
＞→ lastRw = Columns("C").Find("出社人数").Row - 1 '名前列の最終行番号(出社人数の1行上)
↑
済みません。そこ「B」列です。m(__)m
（半平太） 2023/12/14(木) 07:47:14
修正して、実行できました。
色が消えないのですが、これは仕方のないことでしょうか？
（まっつん） 2023/12/14(木) 19:45:51
プログラム「clearFormula」に下の一文を挿入してみてください。
＞Private Sub clearFormula(Ws As Worksheet, TopLeft As Range, rowsToClear As Long) '(数式を消す)
＞ With Ws
＞ On Error Resume Next
＞ TopLeft.Resize(rowsToClear, 31).SpecialCells(xlCellTypeFormulas, 23).ClearContents
＞ On Error GoTo 0
TopLeft.Resize(rowsToClear, 31).Interior.Pattern = xlNone '← 一文挿入 ☆
＞ End With
＞End Sub
＞'元に戻す関連(終)------------------------
（半平太） 2023/12/14(木) 20:10:23
ありがとうございます。
色も消すことができました。ありがとうございます。
同じ曜日に割り当てられていたのが回避できたのですが、
今度は２〜３日開かず。連続して割り当てされることもでてきました。
どちらかをとるしか難しいのでしょうか。
（まっつん） 2023/12/14(木) 21:39:08
分かりません。
生サンプルの提供がなく、どんなチューニングがいいのか考えようもないため 「旨く行かないと言われても、こちらは対応しません」と申し上げた次第です。
その時点でこの話は打ち切るべきでした。 優柔不断で申し訳なかったです。 m(__)m
（半平太） 2023/12/14(木) 22:55:16
とんでもないです。
大変失礼なことを致しました。
もう充分でございます。
突き放さず、とてもご親切にしていただき、
優しさに大変感謝しております。
（まっつん） 2023/12/14(木) 23:08:56
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.