[[20231203110456]] 『シフト表について』(まっつん) ページの最後に飛ぶ

[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]

 

『シフト表について』(まっつん)

はじめまして。
当方、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	1課	青山		-	-	出張	出張			休	-	
9	2	1課	朝野		-	-						-	
10	3	1課	相田		-	-				早	早	-	
11	4	2課	赤坂		-	-		休				-	
12	5	2課	荒木		-	-						-	
…													
55		出社人数		-	-						-	
56		早			-	-						-	
57		遅			-	-						-	
58		休			-	-						-	
59													
60	48	部長	近藤		-	-	出張	出張				-	
…													

1.56〜58行目の「早」「遅」「休」は日付ごとの集計を出したい。
 60行目以降の管理職の方々の早退などは含めない。
 55行目は54行目までの人数から「早」「遅」「休」を差し引いた
 出社人数を集計したい。
 早も遅は半日出社していても1でカウントする。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	青山	1課	〇	〇	〇				〇		PM	12/1(会議)	
5	朝野	1課	〇	〇	〇						〇		
6	相田	1課		〇	〇	〇	〇				〇	12/1(会議)	
7	赤坂	2課	〇	〇	〇				〇		PM		
8	荒木	2課	〇	〇	〇						〇	産休	
…													
22	田中	経理	〇	〇	〇				〇		AM	12/1(会議)	
23	松田	経理		〇	〇		〇	〇		〇	〇		12/1〜12/8
24	塩田	総務											12/11〜12/15
…													
51	近藤	部長											

3.当番は今後増加することもあります。
 社員リストの3行目の数字は、当番の割り当て人数ですが、
 月により、割り当て人数が変動あり。
 休み、早退、遅刻を考慮して作成。
 例:朝礼は2名ずつ、給湯は1名
 〇の中から、ランダムに担当します。
(組み合う相手はいつも同じにならない)
 朝礼当番→ゴミ当番を一番はじめに優先的に決める。
 電話当番はすべての当番が割り当てられたあとに、
 残りの人数で割り当てる。(午前と午後で4人ずつ)
 社員リストの電話当番の欄に例えば「AM」とあるときは、
 AMのみ担当する。

4.電話当番以外の当番は連続にならないように配慮。
 朝礼とゴミ当番は特に、それぞれ2〜3日(土日祝日のぞき)あける。
 電話当番は連続でもかまわない。
 なるべく月、一人の当番回数が同じになるようにしたい。

5.このシフト表は総務管理職が管理し、毎月20日ぐらいに作成しています。
 割り振られた当番の 「!」がついているもの以外は新たにシフト表に
 反映するようにしたい。 
 朝礼=セルの色がオレンジ
 ゴミ=セルの色が黄色
 車両=セルの色が茶色
 給湯=セルの色が薄ピンク
 郵便=「〒」の文字
 電話=水色と「AM」や「PM」の文字

6.電話当番だけは別シートに午前と午後に分け、表にしたい。
 

<例>

	A	B	C
1	電話当番	AM	PM
2	12月1日(金)	朝野	松田
3	12月2日(土)	-	-
4	12月3日(日)	-	-
5	12月4日(月)	田中	相田

7.社員リストに補足や在宅に入力がある場合は、
 その日以外で当番を割り振られる。
 産休でお休みされる場合は、シフト表から名前を消すのではなく、
 グレーアウトにしたい。出社人数には、いれない。

8.在宅に期間は先に15〜20日までに総務が決め、それをシフト表に
 色付けしています。
 社員リストに在宅期間を入力したあと、マクロを実行すると、
 その期間が色付けされるようにしたい。
 

すべてこのシフト表を2人がかりで手作業で行っておりますが、
簡略化できるようにしたいです。
どうかご教授よろしくお願い致します。

< 使用 Excel:Excel2021、使用 OS:Windows10 >


 >すべてこのシフト表を2人がかりで手作業で行っておりますが、
 >簡略化できるようにしたいです。

 「したい」が盛りだくさんですが、全て手作業で行っているんですか?
 簡略化とは具体的にどういったことですか?

(tkit) 2023/12/04(月) 11:45:40


tkitさん

「したい」と書いておりますが、現在すべて手作業で行っています。
シフト表の、出社人数・早退遅刻休みなどの集計は関数で計算しております。
社員名も社員リストからリンクされるようにしておりますが、
異動などで行削除や入れ替えなどを行えられれば割と楽ですが、
シフト表の計算式がくるってしまうため、入力しなおしています。
当番を決めるのも人数が多い為、時間がかかります。
電話当番に関しては、現時点ではシフト表に載せておらず、
当番を割り当ててから電話当番を決めているので、別のシートに作成しております。
簡略化とは、手作業で当番を割り当てたり、別シートで電話当番を作成すると、
時間がかかることと、ランダムに組み合わせを決めているので、
会議のある日に当番を割り当ててしまったり、当番が割り当てたのに電話当番まで
割り当ててしまったりとミスをすることもあり、
そのあとの調整にもまた時間がかかるので、
マクロで割り当てできるようになったらと思い、投稿いたしました。

自分でも過去の投稿を参考にマクロに挑戦してみたのですが、
計算式やリンクが消えてしまうなど、知識がないのでうまくできませんでした。
(まっつん) 2023/12/04(月) 17:53:10


>シフト表の、出社人数・早退遅刻休みなどの集計は関数で計算しております。
なぜ質問1はそのように書いているんですか。
>シフト表の計算式がくるってしまうため
式そのものに問題があるのではないですか。
>すべてこのシフト表を2人がかりで手作業で行っておりますが、
「を元に作成しております。」の式を参考にして
そのようになるように式を組み立てたらどうですか。

質問8は条件書式でも出来そうな気がしますけど。

要件が複雑すぎるので誰も回答する気はないと思いますよ。
私もその1人です。
今まで通りにやってください。

(IT) 2023/12/04(月) 21:44:00


ITさん

コメントありがとうございます。
そうですね。
最後の一言、つらくなりました。
(まっつん) 2023/12/04(月) 21:55:12


思うに

最初に重要な1,2個の改善に絞って依頼した方が回答者もやり易いのではと。。。。
勝手な外野の意見です。

(後は、それができてから小出しで。。。。
   ただし、付け足しできる範囲内で)

(外野の補欠) 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


半平太さん

ご質問ありがとうございます。

・本当に頭に「!」があるんですか? 
・>「!」がついているもの以外は新たにシフト表に 反映するようにしたい。

 なぜ鍵とメールは反映しなくていいのですか?

「!」はついています。
シフト表は総務管理職が管理しており、「!」マークのものは全員が見られるシフト表には
載せないようにしています。
前に鍵当番もシフト表に載せていたのですが、社員間で勝手な交代をし、
運の悪いことが重なり、鍵が開かない、紛失などトラブルがありました。
メールに関しても、似たような問題がありました。
ですから、鍵やメールは、総務だけが把握し、鍵当番当日、本人へ直接メールで
案内しています。
「!」の記号に特にこだわりはありません。☆でも◎でもいいです。
当番を割り当てたあと、鍵とメール当番だけは手作業で別シートにうつす為、
総務が見落とさない様目印としてつけています。
誰が当番かはわからないようにしています。

・各自、ひと月当たり、何回くらい当番に当たるんですか? 

5〜6ほどでしょうか。
電話の多い月はもう少し増えるかもしれません。

・質問文の「〇」が漢数字になっています。

失礼いたしました。記号の○です。

・ 産休って、月途中で職場復帰することはないのですか?

基本的に月初ですが、保育所などの関係でそうはいかない方も中にはおられます。
長らく休んで、月途中で復帰される場合は、その月の当番を割り当てておりません。

・会議は、月1回だけなんですか?

基本的にはそうです。ただ、そうでない場合もあります。
そういう場合も前もってわかっています。

・在宅期間は、月1回だけなんですか?

はい。在宅システムを設けていない部署(総務など)もあるため、
担当者リストに期間を書いたところだけ、シフト表に載せております。

・本人希望とか管理者希望で予め当番をきめることはあるか

ありません。
事情を聞き、やむを得ない場合、担当者リストの○印をはずすというような
ことはしたことがあります。

・早退や遅刻は当番に当たらない、と言う意味ですか

 他の会社には、遅刻でも「午後の電話番」はやらせる、なんて所もあるらしいですが・・

早退や遅刻が申告通りとは限らないので、当番は当てておりません。

・組み合う相手はいつも同じにならない

 これは何の当番における組み合わせの話なんですか?

電話以外の2人以上の組み合わせのときです。
(申し訳ありません。ゴミ当番も現在は2人体制でした)
いろんな方とコミュニケーションがとれるよう、
ランダムな組み合わせにしております。

・当番密度(?)が高くなりますよね。

 この辺りはどう云う考えで(割り切りで)シフトを組んでいるのですか?

在宅は休暇者と同じ扱いにしていません。今月少なくなったとしても、
それはそれとし、その期間以外で調整し、少ない場合は電話当番を割り当てて
いました。
予定休をとられている方も、休みを考慮し、割り当てています。
平均値がなるべく同じになるようにしていました。

鍵・メール→役職クラスのみ
朝礼・ゴミ→課長クラスまで全員
車両・在庫→一般男子社員
給湯・郵便→一般女子社員
電話→役職クラスは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


   1.社員リストは以下の形式とします。

  行  __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         

   2.祝日データ範囲は、「祝日リスト」と名前定義してあるものとします。
     日付データ範囲及び未入力セル範囲とし、当該範囲内に文字データは無いもの(元日とか)。

   3.実行は、マクロ「Main」を実行するか、シフト表の1行目のどこかしらを右クリックする。
     通常は、満足のいくシフト表が出来るまで、シフト表の1行目を何回か右クリックすることになる。

   4.もし、出力結果を消して、元の手入力状態に戻したい場合は、マクロ「resetOriginal」を実行する。
     単に、数式を消すだけですけども。

   5.作業シートと電話シートは、自動的に挿入されます。

   6.使用するマクロは以下の3か所に分けてコピペする

   (1)クラスモジュールを一枚挿入して、クラス名(オブジェクト名)を変更する。
     Class1 → Staff
     当該モジュールに後記のクラスモジュール用のプログラムをコピペする。

   (2)シフト表のモジュール(重要:標準モジュールではない)に後記の
     シートモジュール用のプロシージャをコピペする

   (3)標準モジュールに後記の
     標準モジュール用のプログラムをコピペする

  7.マクロコード
  (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


半平太さん

!鍵当番についてですが、当番ができる人数が5名で、
平日が5日なので、毎週同じ曜日に割り当てられます。
これを回避する方法はないでしょうか。

よろしくお願い致します。
(まっつん) 2023/12/13(水) 22:20:49


↑もう一つ質問し忘れておりました。

リセットをかけようとしたところ、

オブジェクト変数またはWithブロック変数が設定されていません。

とエラーがかかりました。
修正方法を教えていただけますでしょうか。
よろしくお願い致します。
(まっつん) 2023/12/13(水) 22:30:03


 >毎週同じ曜日に割り当てられます。

 そうなんですか。
 確信はないですが、以下の修正をしてみてください。

 1.シフト表モジュール用の中
 >   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

 2.staffモジュール用に以下のメソッドを追加。
   場所はどこでもいいですが、最後尾にでも。

     Sub setRandOrderEveryDay(RdAry)
          randomPos = RdAry(Idx)
      End Sub

 >リセットをかけようとしたところ、
 >オブジェクト変数またはWithブロック変数が設定されていません。

 具体的にどの行で発生しましたか?

(半平太) 2023/12/13(水) 23:16:01


半平太さん

早速のお返事ありがとうございます。

1.同じ曜日に割り当てられていた当番ですが、
  回避できました。

  ありがとうございます!

2.シフト表コード
  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


半平太さん

ありがとうございます。
色も消すことができました。ありがとうございます。

同じ曜日に割り当てられていたのが回避できたのですが、
今度は2〜3日開かず。連続して割り当てされることもでてきました。
どちらかをとるしか難しいのでしょうか。
(まっつん) 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.