エクセルの学校：全文検索：Hyper Estraier：シリアル値とは

Results of 1 - 1 of about 779 for シリアル値とは (0.008 sec.)

シリアル値 (1875), とは (29356)

[[20231014175401]]: #score: 8288; @digest: 764fa5a63790b8c2c1fbb48c6ffd5076; @id: 95289; @mdate: 2023-10-26T12:11:57Z; @size: 68552; @type: text/plain; #keywords: rwnum (479862), clnum (391322), レワ (312930), 務チ (309995), wswk (279303), wsshift (180745), vwk (148260), rshift (146889), 便当 (144060), vtock (141118), rngsorted (131815), 当番 (124938), rwhit (112765), ク当 (110514), 便[ (93320), テレ (88997), msgalert (82497), lastrw (78430), 番日 (65766), 郵便 (39229), ト表 (31425), シフ (27998), 業務 (24898), チー (22480), 業シ (16944), （tk (16401), 2023 (13855), interior (12766), フト (12444), ーク (10990), チェ (10301), 半平 (10292); 『シフト表平等な当番表』（TKG）
はじめまして。現在、25人の従業員で、シフト表は年と月を入力すると土日祝や休業日はグレーアウトする表を使用しています。（行に日付、列に従業員名）まずはじめに、4〜5人ずつ週替わりのテレワーク（A・B・C・D）チームを決め、色分けし、ソートします（毎月組み合わせ変動）それを、シフト表に入力したあと、従業員が希望する休みを入力し、テレワークや希望する休み以外で、業務チェック当番を先輩従業員10人の中から2人、郵便当番をそれ以外のメンバーから2人選出しています。なるべく連続して当番をすることがないよう、平等に決めるのがとても大変で時間を費やし、それでも重複してしまうことがあり、苦労しています。また忙しいときは3か月間だけパートを何人か雇うときもあり、人数が変動する時期もあります。どうか平等なシフト表をつくるマクロなどがあれば、教えていただけないでしょうか。どうぞよろしくお願いいたします。＜使用 Excel:Excel2019、使用 OS:Windows10 ＞ ---- 単純に考えるなら[多少の凸凹は有っても] 要当番日に名簿の中から上から順番に選出して割り振り、最後まで行けば最初に戻るを繰り返す。でよろしいのでは^^; (*^^*)v m(__)m （隠居Z） 2023/10/14(土) 19:27:46 ---- 隠居Z様ご回答ありがとうございます。そういった方法で入力をしておりますが、毎月20名以上を手入力で、テレワークではない社員もおりますので、それぞれ同じサイクルではないので、公平に入力していくのが大変です。なにか方法があればと、すがる思いで質問させていただきました。（TKG） 2023/10/14(土) 20:05:08 ---- ＞4〜5人ずつ週替わりのテレワーク（A・B・C・D）チームを決め、色分けし、ソートします（毎月組み合わせ変動）＞それを、シフト表に入力したあと、従業員が希望する休みを入力しこの状態の表がどうなっているのか分からないので、全貌が推測可能なレベルのサンプルデータをアップできませんか? この質問は、一カ月間の「業務チェック当番」と「郵便当番」を各2名、できるだけ平等に割り振りたいって話ですね? ※まぁ、平等と言っても、単なる回数なのか、出勤日数比で同率にするとかありますが、当面、厳密なことは置いておきます。バイトの話は何の為に出したんですか? バイトも郵便当番をやるんですか?（バイトでも簡単に覚えられる仕事なんですか）バイトは月の途中で入ってくるような気がするんですが、中途となれば明らかに出勤日数比でみないと不公平も甚だしくなりますよね。（半平太） 2023/10/14(土) 20:12:17 ---- 1.この割振りとテレワークの関係はどうなっているんですか? 2.テレワークって、1カ月間フルに自宅勤務なんですか? （半平太） 2023/10/14(土) 20:21:59 ---- 半平太様ご回答ありがとうございます。下記の様な感じでわかりますでしょうか。 10/1 10/2 10/3 10/4 10/5 10/6 10/7 10/8 10/9 10/10 チーム社員日月火水木金土日月火水 1 A あ ← テレワーク → 2 A い ← テレワーク休 → 3 A う ← テレワーク → 休 4 A え ← テレワーク → 5 B お休 ← テレワーク 6 B か ← テレワーク 7 B き休 ← テレワーク 8 B く休 … 15 E そ 16 E た休 17 E ち休 18 E つ休 … … ＞この質問は、一カ月間の「業務チェック当番」と「郵便当番」を各2名、できるだけ平等に割り振りたいって話ですね? はい。その通りです! ＞バイトも郵便当番をやるんですか? はい。先ほどパートと書きましたが、短期派遣社員さんを2〜3人ほど月初めから3カ月お願いしております。 1.この割振りとテレワークの関係はどうなっているんですか? テレワークの際は、会社での当番は無理なので、それ以外の方で割り振りしております。 2.テレワークって、1カ月間フルに自宅勤務なんですか? 週替わりです。ただ1カ月ごとチーム内のメンバーが変わるので、例えば今月であれば30日（月）31日（火）までCチームがテレワークしたとしても、 11月からはリセットされ、新しいメンバーでAチームから再スタートとなります。（テレワークに関しては平等とはなっていません。）どうぞよろしくお願いします。（TKG） 2023/10/14(土) 20:57:01 ---- 追記:←テレワーク→と書いてある箇所は、今回はわかりやすいようにそのように書きましたが、普段はセルをチームごとのカラーで塗りつぶしています。（TKG） 2023/10/14(土) 21:00:15 ---- 一番左に列番号がありますが、業務チェックができる方は1〜10まで、11以降は郵便当番としております。（TKG） 2023/10/14(土) 21:07:46 ---- ＞下記の様な感じでわかりますでしょうか。「業務チェック当番」と「郵便当番」を記入した方が分かりやすいのでは。（?） 2023/10/14(土) 21:27:58 ---- 10/1 10/2 10/3 10/4 10/5 10/6 10/7 10/8 10/9 10/10 チーム社員日月火水木金土日月火水 1 A あ ← テレワーク → ◎ 2 A い ← テレワーク休 → ◎ 3 A う ← テレワーク → 休 ◎ 4 A え ← テレワーク → ◎ 5 B お休 ◎ ← テレワーク 6 B か ◎ ← テレワーク 7 B き休 ◎ ◎ ← テレワーク 8 B く ◎ 休 ← テレワーク … 15 E そ〒〒 16 E た〒休 17 E ち〒〒休 18 E つ〒〒休 … … 先ほどのは〒当番と業務チェック当番の入力を忘れておりました。業務チェック当番は「◎」〒当番は「〒」としておきます。普段はセルを色でチェック当番は黄色、郵便は緑で塗りつぶしております。（TKG） 2023/10/14(土) 21:44:23 ---- 当番はランダムで決めていますが、連続になるべくならないようにしています。忙しい時期はチェック当番は2人、そうでないときは1人で割り振っています。（TKG） 2023/10/14(土) 21:48:59 ---- ＞一番左に列番号がありますが、業務チェックができる方は1〜10まで、11以降は郵便当番としております。 ↑すみません。上記文間違った情報をのせてしまいました。正しくは、社員リストを別のシートに作っており、社員ごと、業務チェックの人、郵便当番の人を示してあります。＜例＞あ業務チェックい業務チェック … た郵便ち郵便異動があっても対応できるようにしております。説明不足で申し訳ありません。よろしくお願いいたします。（TKG） 2023/10/14(土) 22:28:18 ---- ＞正しくは、社員リストを別のシートに作っており、 1.名前列と業務区分列の列の番号は、何と何ですか? 例:A列とD列 2.実際のシフト表のC列より右は、文字は「休」だけ書かれていて、後は色づけのみで構成されているのですか? （半平太） 2023/10/14(土) 23:05:34 ---- ＞1.名前列と業務区分列の列の番号は、何と何ですか? 例:A列とD列名前の列はA列業態区分の列はBですちなみにC列にはテレワークチームです。＞2.実際のシフト表は、文字は「休」だけ書かれていて、後は色づけのみで構成されているのですか? はい。正しくは文字は、「休」「遅（遅）」「早（早退）」「前（午前休）」「後（午後休）」のみです。色付けだけの方が見やすいということで、そうしております。郵便は色と「〒」マークがあった方がわかりやすい気がします。よろしくお願いします。（TKG） 2023/10/14(土) 23:18:55 ---- ＞正しくは文字は、＞「休」「遅（遅）」「早（早退）」「前（午前休）」「後（午後休）」のみです。それだと「休」以外にも、当日は当番を割り振っちゃいけない人ってあるんじゃないですか? ※遅刻だろうが、午前休だろうが、お構いなしに当番を割り振っていいんですか? （半平太） 2023/10/14(土) 23:39:00 ---- >それだと「休」以外にも、当日は当番を割り振っちゃいけない人ってあるんじゃないですか? ※遅刻だろうが、午前休だろうが、お構いなしに当番を割り振っていいんですか? はい。その通りです! なにか文字が入っている場合は、当番にあてないようにしています。いろいろ細かいところまで求めてはいけないと思い、省略しておりました。詳しいところまで考えてくださり、ありがとうございます。よろしくお願いします。（TKG） 2023/10/14(土) 23:46:24 ---- 申し訳ないですが、状況説明に後出しが多すぎです。私は一旦退散します。他の回答者のレスをお待ちください。 ※他の回答者から有効なレスが付かない様なら後日カンバックします。（半平太） 2023/10/14(土) 23:55:07 ---- 半平太さんありがとうございます。おっしゃる通りです。不快にさせてしまい、本当に申し訳ありませんでした。（TKG） 2023/10/15(日) 00:02:03 ---- ＞業務チェック当番は「◎」〒当番は「〒」としておきます。を見るとチェックは毎日ではないんですね。なにか規則でもあるんですか。（IT） 2023/10/15(日) 08:04:03 ---- いいえ。毎日です。わかりづいらい箇所がありましたでしょうか。（TKG） 2023/10/15(日) 09:39:46 ---- ＞わかりづいらい箇所がありましたでしょうか。ところどころ歯抜けが見受けられますけど。（IT） 2023/10/15(日) 10:35:58 ---- 歯抜けではなく、上の表では「…」として続きがあることを示しているつもりでした。当番は毎日あります。（TKG） 2023/10/15(日) 10:43:07 ---- 別シートの従業員マスタ? 予想図 ^^; 整理のお手伝いだけでも。。。(￣▽￣) シート名不明 (*^^*)最後の二人は臨時の方のつもり |[A] |[B] [1] |Name01|業務チェック [2] |Name02|郵便 [3] |Name03|業務チェック [4] |Name04|郵便 [5] |Name05|郵便 [6] |Name06|業務チェック [7] |Name07|業務チェック [8] |Name08|郵便 [9] |Name09|業務チェック [10]|Name10|郵便 [11]|Name11|郵便 [12]|Name12|郵便 [13]|Name13|業務チェック [14]|Name14|郵便 [15]|Name15|郵便 [16]|Name16|郵便 [17]|Name17|郵便 [18]|Name18|業務チェック [19]|Name19|郵便 [20]|Name20|郵便 [21]|Name21|業務チェック [22]|Name22|業務チェック [23]|Name23|郵便 [24]|Name24|業務チェック [25]|Name25|郵便 [26]|Name26|郵便 [27]|Name27|郵便外しておりましたらご修正を。。。m(__)mでわ（隠居Z） 2023/10/15(日) 12:20:54 ---- 隠居Z様ありがとうございます。別シートに関しては、整理できております。変更する箇所があれば今後変更していきたいと思います。ありがとうございます。（TKG） 2023/10/15(日) 13:30:43 ---- 質問内容を再確認させてください。 1.この割振り作業は、月初より少し前に行うのが通例である。(当方の推測) 月中でこの作業を行うことはない(少なくとも、このプログラムは使わない) 2.当月に入って、急病等で休む人が出た場合は、別の人に臨時で頼む。(管理者か、本人が個人的に頼む）代わってあげた人は、月末までに到来する自分の当番を休んだ人と入れ替えて貰える(表の色付け修正は手作業で行う) 2.シフト表は、休等の文字が記入されている日には当番に当てない。休みに関係ない文字は記入されない(「新人さん入所」「雨なら休む」なんて書込みはない) 3.休とは逆に、何月何日に当番をやりたい、と自己申告する人は存在しない。 4.シフト表は、休み絡み文字と色付けセルだけで構成されている。色の種類は3種類しかない。 5.テレワークの期間のセルは、1週間分((月から金)全て色付けされている。 →何色なんですか? チームごとに違うのですか? その場合、何色と何色が使われているのですか? 6.土日は対象外である。祝日はどうなっていますか?(対象外の場合、祝日リストはどこかに作成済みですか?） 7.一行目の日付は、シリアル値ですね?(つまり実際は、2023/10/1 などと入っており、年情報が分かる）（半平太） 2023/10/15(日) 17:53:33 ---- 半平太様ありがとうございます! お答えいたします。＞1.この割振り作業は、月初より少し前に行うのが通例である。その通りです。月中での作業は行っておりません。いつも月の25日までに各自で予定休の入力期限に設定しており、そのあとに割り振っています。そして大体月末より少し前に割り振った当番を確認していただいております。＞2.当月に入って、急病等で休む人が出た場合は、別の人に臨時で頼む。 (管理者か、本人が個人的に頼む）代わってあげた人は、月末までに到来する自分の当番を休んだ人と入れ替えて貰える(表の色付け修正は手作業で行う) はい。その通りです! 出社されている方の中で、管理者または本人がお願いしています。当月に入っての当番表は手作業での修正しています。＞2.シフト表は、休等の文字が記入されている日には当番に当てない。休みに関係ない文字は記入されない(「新人さん入所」「雨なら休む」なんて書込みはない) はい。ありません。＞3.休とは逆に、何月何日に当番をやりたい、と自己申告する人は存在しない。はい。いません。＞4.シフト表は、休み絡み文字と色付けセルだけで構成されている。色の種類は3種類しかない。＞5.テレワークの期間のセルは、1週間分((月から金)全て色付けされている。 →何色なんですか? チームごとに違うのですか? その場合、何色と何色が使われているのですか? テレワークのチームは大体4チームになるので、薄青、薄黄、薄緑、薄赤でわけております。業務チェック当番は黄色、郵便当番は緑で塗りつぶしております。見やすいようにそうしておりましたが、チーム別で色を分けることに特に重視はしていません。＞ 6.土日は対象外である。祝日はどうなっていますか?(対象外の場合、祝日リストはどこかに作成済みですか?）はい。土日は対象外であり、祝日や休業日は別のシート「祝日リスト」があります。セルA1「名称」B1「日付」元旦 2023/1/1 休業日 2023/1/2 … … といような形でリストにしております。当番表は、【Excel講座】98%おまかせ!超便利な「シフト表」の作り方 https://www.youtube.com/watch?v=X7yHIMyVX1s&t=3083s を参照に作られてあります。少しアレンジし、A列?aAB列チーム、C列社員名、D列→日付となっています >7.一行目の日付は、シリアル値ですね?(つまり実際は、2023/10/1 などと入っており、年情報が分かる）日付は年はD1のセル、月はG1のセルに入力しており、日付はシンプルにD6に1、E6に2…と数字だけの入力になっております。日付の下に曜日がD7に「日」E7に「月」・・とあり、その曜日のセルが、 =DATE($D$1,$G$1,D6)と入力されており、書式設定”aaa”で曜日化しております。遅くなり申し訳ありません。どうぞよろしくお願いいたします。（TKG） 2023/10/15(日) 19:45:10 ---- 失礼いたしました。 7.の回答について、文字化けしております。 A列?aA →A列はナンバーです。申し訳ありません。（TKG） 2023/10/15(日) 19:47:10 ---- ＞テレワークのチームは大体4チームになるので、薄青、薄黄、薄緑、薄赤でわけております。＞業務チェック当番は黄色、郵便当番は緑で塗りつぶしております。＞見やすいようにそうしておりましたが、チーム別で色を分けることに特に重視はしていません。 1.でしたら、「薄青」で統一してください。テレワークかどうかをセルの色で判断するしかないので、これは、非常に重要な決め事になります。(Interio.Color:15773696）シフト表の色は都合3種類しかないものとなります。(念押し) ＞祝日や休業日は別のシート「祝日リスト」があります。 2.祝日は、土日と同じく当番は割り振らないと理解しました。祝日リストは、名前定義で「祝日リスト」と言う名前にしてあるものとします。＞日付はシンプルにD6に1、E6に2…と数字だけの入力になっております。＞日付の下に曜日がD7に「日」E7に「月」・・とあり、その曜日のセルが、＞=DATE($D$1,$G$1,D6)と入力されており、書式設定”aaa”で曜日化しております。・・と言うことは、この様に表示されているセルはシフト表に無いと言うことになりますね? ↓ ＞ 10/1 10/2 10/3 10/4 10/5 10/6 10/7 10/8 10/9 10/10 （半平太） 2023/10/15(日) 20:51:07 ---- >1.でしたら、「薄青」で統一してください。承知しました。薄青で統一します。 >2.この様に表示されているセルはシフト表に無いと言うことになりますね? ↓ ＞ 10/1 10/2 10/3 10/4 10/5 10/6 10/7 10/8 10/9 10/10 はい。申し訳ありません。このように表記されておりません。はじめて投稿したため、わかりやすくと思い書きましたが、きちんと本来ある表通りにご説明した方がよかったと昨日反省したところです。どうぞよろしくお願いいたします。（TKG） 2023/10/15(日) 21:23:08 ---- プログラム(たたき台)は明日アップします。（半平太） 2023/10/15(日) 23:20:28 ---- 半平太様夜分遅くまで本当にありがとうございます! （TKG） 2023/10/15(日) 23:32:27 ---- とりあえず、以下のコードだとどうなるか実データでテストしてみてください。前提 1.祝日のセル範囲は、名前定義で「祝日リスト」としてある。 2.シートを1枚挿入して、シート名を「作業」としてある。実行方法「シフト表」シートのD7セルを右クリックする。コードの貼付け方法 1.「シフト表」のシート見出しを右クリックして、「コードの表示」を選ぶ（VBE画面になる） 2.画面中央の白いエリアに後記のマクロコードをコピペする。(※標準モジュールには貼り付けないでください） 3.ALT+F11キーを押下してエクセルに戻る '↓コピペするコード Enum col 業務区分 = 1 前回当番当番日数行番 End Enum Private Sub Worksheet_BeforeRightClick(ByVal target As Range, Cancel As Boolean) If target.Address(0, 0) = "D7" Then Cancel = True Call JobAssignment(target) End If End Sub '「作業」シートを1枚挿入して置く Private Sub JobAssignment(target As Range) Dim WsShift As Worksheet, wsWk As Worksheet Dim rShift As Range Dim rWK As Range Dim vWK Dim vToCK() Dim lastRw As Long Dim RWNum As Long, CLNum As Long Dim rngSorted As Range Dim cnt As Long Dim kbn Dim rwHit As Long Dim Dy As Date Dim Hldy As Range Set Hldy = Application.Range("祝日リスト") Set WsShift = Worksheets("シフト表") Set wsWk = Worksheets("作業") 'シフト表の初期化 (テレワーク色のみ残す) With WsShift lastRw = .Cells(.Rows.Count, "C").End(xlUp).Row Set rShift = .Range("A1:AH1").Resize(lastRw) End With For CLNum = 4 To 34 For RWNum = 8 To lastRw If rShift(RWNum, CLNum).Interior.Color <> 15773696 Then rShift(RWNum, CLNum).Interior.Color = 16777215 End If Next RWNum Next CLNum '作業シートをクリア、シフト表を転記する wsWk.UsedRange.Clear rShift.Copy wsWk.Range("A1") Set rWK = wsWk.Range(rShift.Address) vWK = rWK.Value 'テレワーク色を文字化(♪）する For CLNum = 4 To 34 For RWNum = 8 To lastRw If rWK(RWNum, CLNum).Interior.Color = 15773696 Then vWK(RWNum, CLNum) = "♪" End If Next RWNum Next CLNum rWK.Value = vWK '現状文字化を作業シートに反映 'チェック用数式を入力 wsWk.Range("AP6") = target.Column inputFmlOnce wsWk, rWK.Rows.Count - 7 '8行目からが数式入力の為、マイナス7行とする ReDim vToCK(1 To UBound(vWK), 1 To 4) '割当本番 Application.ScreenUpdating = False For CLNum = target.Column To 34 '営業日チェック+空白対策 Dy = IIf(vWK(7, CLNum) = "", Application.WorkDay_Intl(vWK(7, 4), 1, "1111110"), vWK(7, CLNum)) If Application.NetworkDays(Dy, Dy, Hldy) = 1 Then '当番日数と前回当番を更新 For RWNum = 8 To UBound(vToCK) wsWk.Cells(RWNum, "AK") = IIf(vWK(RWNum, CLNum - 1) = "◎" Or vWK(RWNum, CLNum - 1) = "〒", 1, 0) wsWk.Cells(RWNum, "AL") = vToCK(RWNum, 当番日数) Next RWNum inputFmlAgain wsWk, rWK.Rows.Count - 7, CLNum With wsWk.Sort .SortFields.Clear .SortFields.Add Key:=wsWk.Range("AP8"), SortOn:=xlSortOnValues, _ Order:=xlAscending, DataOption:=xlSortNormal .SetRange wsWk.Range("AP7").Resize(rWK.Rows.Count - 6) .Header = xlYes .Apply End With Set rngSorted = wsWk.Range("AP1:AP" & lastRw) For Each kbn In Array("1", "2") cnt = 0 For RWNum = 8 To UBound(vToCK) If Left(rngSorted(RWNum, 1), 1) > "2" Then Exit For Else If Left(rngSorted(RWNum, 1), 1) = kbn Then rwHit = Val(Right(rngSorted(RWNum, 1), 2)) vWK(rwHit, CLNum) = IIf(kbn = "1", "◎", "〒") vToCK(rwHit, 当番日数) = vToCK(rwHit, 当番日数) + 1 cnt = cnt + 1 If cnt >= 2 Then Exit For End If End If End If Next RWNum Next kbn End If Next CLNum wsWk.Range("A1").Resize(UBound(vWK), UBound(vWK, 2)) = vWK '割振り予定(文字表示) 'シフト表を色付け Dim msgContinu As String For CLNum = target.Column To 34 For RWNum = 8 To lastRw If (vWK(RWNum, CLNum - 1) = "〒" And vWK(RWNum, CLNum) = "〒") Then msgContinu = msgContinu & vbCrLf & vWK(RWNum, 3) & "さん:" & Format(vWK(7, CLNum), "mm/dd") End If If vWK(RWNum, CLNum) = "◎" Then WsShift.Cells(RWNum, CLNum).Interior.Color = 65535 ElseIf vWK(RWNum, CLNum) = "〒" Then WsShift.Cells(RWNum, CLNum).Interior.Color = 5287936 End If Next RWNum Next CLNum Application.ScreenUpdating = True If msgContinu <> "" Then MsgBox "連続" & msgContinu Else MsgBox "連続当番なし" End If End Sub Private Sub inputFmlOnce(wsWk As Worksheet, RW As Long) wsWk.Range("AJ7:AM7").Value = Array("業務区分", "前回当番", "当番日数", "行番") wsWk.Range("AP7").Value = "SORT" wsWk.Range("AJ8").Resize(RW).FormulaLocal = "=IF(LEFT(VLOOKUP(C8,社員リスト!A:B,2,FALSE))=""業"",1,2)" wsWk.Range("AJ8").Resize(RW).Value = wsWk.Range("AJ8").Resize(RW).Value wsWk.Range("AM8").Value = 8 '行番号を振る wsWk.Range("AM8").AutoFill Destination:=wsWk.Range("AM8").Resize(RW), Type:=xlFillSeries End Sub Private Sub inputFmlAgain(wsWk As Worksheet, RW As Long, aimCol As Long) wsWk.Range("AP6").Value = aimCol wsWk.Range("AP8").Resize(RW).FormulaLocal = _ "=((IF(INDEX(A:AH,ROW(),AP$6)<>"""",6,0)+AJ8)*10+ak8)*10000+AL8*100+AM8" wsWk.Range("AP8").Resize(RW).Value = wsWk.Range("AP8").Resize(RW).Value End Sub （半平太） 2023/10/16(月) 10:26:00 ---- 半平太様本当に素晴らしいものをありがとうございます!! 先ほど試してみました。「実行時エラー”13” 型が一致しませんと出ました。 '営業日チェック+空白対策 Dy = IIf(vWK(7, CLNum) = "", Application.WorkDay_Intl(vWK(7, 4), 1, "1111110"), vWK(7, CLNum)) → If Application.NetworkDays(Dy, Dy, Hldy) = 1 Then ↑「→」の部分が黄色くなっております。どうしたらいいでしょうか。指示に従います。そして、「祝日リスト」の名前定義ですが、日付のみの列を名前定義設定でしょうか。それとも名称と日付の列を名前定義設定するのでしょうか。私は名称と日付の列を名前定義設定しておりましたが、どのようにしたらいいでしょうか? よろしくお願いいたします。（TKG） 2023/10/16(月) 12:43:30 ---- きっと忙しいだろう半平太さんにかわってひまじじいが代返。＞そして、「祝日リスト」の名前定義ですが、＞日付のみの列を名前定義設定でしょうか。日付のみかつ「日付」とかの見出しは含めないようにすれば NetworkDays のエラーは出なくなるはず。（xlg） 2023/10/16(月) 13:25:53 ---- xlg様ありがとうございます! 早速指定しなおして、試してみたところ、うまく表示されました!! 本当にうれしくて、うれしくて、感動しました。ただ、チーム別に薄青で表示されません。どのようにしたら、週替わりでうまくいくでしょうか。また指示に従います。よろしくお願いします。（TKG） 2023/10/16(月) 14:03:04 ---- 半平太様素晴らしいプログラミングをありがとうございます。 1.当番をしない方もシフト表にのせています。（部長など）そういった場合は、社員リストの業務区分を空白にしております。妊娠や介護など突然そういう状況になった方も、当番があたらないように空白にすることもあります。そういった方も当番をあてないようにできないでしょうか。 2.色をリセットする操作はどのようにしたらいいでしょうか。 3.時々エクセルを右クリックしても、作動しないことがあります。どこかにボタンを作り作動することはできますでしょうか。どうか、よろしくお願いいたします。なにかこちらで設定することがあればご指示ください。（TKG） 2023/10/16(月) 14:34:01 ---- ＞ただ、チーム別に薄青で表示されません。＞どのようにしたら、週替わりでうまくいくでしょうか。チーム別に色付けとは、どう言う意味なんでしょうか? 何か(機械的に)自動でできるようなルールがあるんですか? （半平太） 2023/10/16(月) 14:52:45 ---- ＞半平太様 ↑ さん付けでお願いします。(長くなるかも知れないので) ＞1.当番をしない方もシフト表にのせています。:: ＞そういった方も当番をあてないようにできないでしょうか。当番しない人もリストに載っているのは想定外ですが、業務区分を空白にしてあるのなら、以下の一行を書換えればいいです。＞Private Sub inputFmlOnce(wsWk As Worksheet, RW As Long) ＞ :: ＞ wsWk.Range("AJ8").Resize(RW).FormulaLocal = "=IF(LEFT(VLOOKUP(C8,社員リスト!A:B,2,FALSE))=""業"",1,2)" ↓へ変更 wsWk.Range("AJ8").Resize(RW).FormulaLocal = "=FIND(LEFT(VLOOKUP(C8,社員リスト!A:B,2,FALSE)&""他""),""業郵他"")" ＞2.色をリセットする操作はどのようにしたらいいでしょうか。＞3.時々エクセルを右クリックしても、作動しないことがあります。＞どこかにボタンを作り作動することはできますでしょうか。シフト表を作業シートにコピーしているので、その際、ボタンもコピーされてしまいます。度重なると、ボタンがたんこぶ状になって厄介なことになりますので、それを防ぐためファイr→オプション→詳細設定→切り取り、コピー貼り付け→□挿入したオブジェクトをセルと共に切り取り・・のチェックを外す色のリセットは以下のコードを実行してください。 Sub 色のリセット() Dim CLNum As Long, RWNum As Long, lastRw As Long With Worksheets("シフト表") lastRw = .Cells(.Rows.Count, "C").End(xlUp).Row For CLNum = 4 To 34 For RWNum = 8 To lastRw If .Cells(RWNum, CLNum).Interior.Color <> 15773696 Then .Cells(RWNum, CLNum).Interior.Color = 16777215 End If Next RWNum Next CLNum End With End Sub 私は右クリックで困ったことはないですけどねぇ・・以下のコードを実行してください。 Sub ボタン実行() Call JobAssignment(Worksheets("作業").Range("D7")) End Sub （半平太） 2023/10/16(月) 15:31:46 ---- 全部見切れていませんが、（テレワークの）「チーム別に薄青で表示されません」という件は、半平太さんシフト表で塗りつぶされているという想定 TKG さん社員リストで「テレワーク」と書かれていて、これを反映してシフト表を塗りつぶすイメージという食い違いがあるように思います。「ちなみに（社員リストの）C列にはテレワークチームです。」とありますが、具体的かつ正確にこの C 列はどういう表記になっているのでしょうかね? 期間（開始日・終了日）がないと塗りつぶしできませんが。（xlg） 2023/10/16(月) 15:51:27 ---- 半平太さんお忙しい中、ありがとうございます。修正し、実行してみました。当番をしない方、色のリセット、問題なくできました! ありがとうございます!! ＞チーム別に色付けとは、どう言う意味なんでしょうか? 何か(機械的に)自動でできるようなルールがあるんですか? こちらも説明不足であったと思います。 10/1 10/2 10/3 10/4 10/5 10/6 10/7 10/8 10/9 10/10 チーム社員日月火水木金土日月火水 1 A あ ← テレワーク → 2 A い ← テレワーク休 → 3 A う ← テレワーク → 休 4 A え ← テレワーク → 5 B お休 ← テレワーク 6 B か ← テレワーク 7 B き休 ← テレワーク ←テレワーク→と書いてある箇所は、今回はわかりやすいようにそのように書きましたが、普段はセルをチームごとのカラーで塗りつぶしています。 ↑と、「2023/10/14(土) 21:00:15」に投稿しておりますが、今まで、手動でそのテレワークの期間をチームごと色で塗りつぶしておりました。その塗りつぶしたものを社員が休などを入力していく形をとっております。先日のお話で、チームごとのカラー（A,B,C,D）などするのではなく、テレワーク期間は薄青1色で統一するのだとおもっておりました。ただよく考えれば、今まで手動で行っていたので、期間を設定しているシートがないので、テレワークの箇所を薄青に表示できるわけないですね・・。例えば、社員リストのC列にチームを設定し A列 B列 C列あ業務チェック A い業務チェック D … た郵便 D ち郵便 B どこかにチーム期間始期間終 A 2023/10/1 2023/10/7 B 2023/10/8 2023/10/15 … など、リストに期間を設定すると、その期間は薄青に表示されるというような形は可能でしょうか。（TKG） 2023/10/16(月) 16:17:54 ---- xlgさんありがとうございます。ご指摘通りです。半平太さんはシフト表で塗りつぶされているという想定されていると思い、仮にシフト表で塗りつぶした場合で、実行かけてみましたが、薄青でぬりつぶした箇所が消えてしまいました。「2023/10/16(月) 16:17:54」に投稿したように、期間（平日のみ）を設定する。（当番を設定する日よりも前に設定したいので、当番とは別作業になります）もしくは、先に薄青でぬりつぶした箇所が消えないようにしていただけるとうれしいです。よろしくお願いいたします。（TKG） 2023/10/16(月) 16:24:10 ---- ＞半平太さんはシフト表で塗りつぶされているという想定されていると思い、＞仮にシフト表で塗りつぶした場合で、実行かけてみましたが、＞薄青でぬりつぶした箇所が消えてしまいました。薄青のカラーコードが想定と違うためと思いますので、その色を塗った後、下のVBAを実行して、カラーコードが何か教えてください。 Sub カラーコードチェック() With ActiveCell MsgBox .Address(0, 0) & "のカラーコードは→" & .Interior.Color End With End Sub （半平太） 2023/10/16(月) 16:46:47 ---- 半平太さん試してみました。 P17は 16774877 と表示されました。よろしくお願いします。（TKG） 2023/10/16(月) 17:09:06 ---- '下のコードと全とっかえしてください。 Enum col 業務区分 = 1 前回当番当番日数行番 End Enum Private Sub Worksheet_BeforeRightClick(ByVal target As Range, Cancel As Boolean) If target.Address(0, 0) = "D7" Then Cancel = True Call JobAssignment(target) End If End Sub '「作業」シートを1枚挿入して置く Private Sub JobAssignment(target As Range) Dim WsShift As Worksheet, wsWk As Worksheet Dim rShift As Range Dim rWK As Range Dim vWK Dim vToCK() Dim lastRw As Long Dim RWNum As Long, CLNum As Long Dim rngSorted As Range Dim cnt As Long Dim kbn Dim rwHit As Long Dim Dy As Date Dim Hldy As Range Set Hldy = Application.Range("祝日リスト") Set WsShift = Worksheets("シフト表") Set wsWk = Worksheets("作業") 'シフト表の初期化 (テレワーク色のみ残す) With WsShift lastRw = .Cells(.Rows.Count, "C").End(xlUp).Row Set rShift = .Range("A1:AH1").Resize(lastRw) End With For CLNum = 4 To 34 For RWNum = 8 To lastRw If rShift(RWNum, CLNum).Interior.Color <> 16774877 Then rShift(RWNum, CLNum).Interior.Color = 16777215 End If Next RWNum Next CLNum '作業シートをクリア、シフト表を転記する wsWk.UsedRange.Clear rShift.Copy wsWk.Range("A1") Set rWK = wsWk.Range(rShift.Address) vWK = rWK.Value 'テレワーク色を文字化(♪）する For CLNum = 4 To 34 For RWNum = 8 To lastRw If rWK(RWNum, CLNum).Interior.Color = 16774877 Then vWK(RWNum, CLNum) = "♪" End If Next RWNum Next CLNum rWK.Value = vWK '現状文字化を作業シートに反映 'チェック用数式を入力 wsWk.Range("AP6") = target.Column inputFmlOnce wsWk, rWK.Rows.Count - 7 '8行目からが数式入力の為、マイナス7行とする ReDim vToCK(1 To UBound(vWK), 1 To 4) '割当本番 Application.ScreenUpdating = False For CLNum = target.Column To 34 '営業日チェック+空白対策 Dy = IIf(vWK(7, CLNum) = "", Application.WorkDay_Intl(vWK(7, 4), 1, "1111110"), vWK(7, CLNum)) If Application.NetworkDays(Dy, Dy, Hldy) = 1 Then '当番日数と前回当番を更新 For RWNum = 8 To UBound(vToCK) wsWk.Cells(RWNum, "AK") = IIf(vWK(RWNum, CLNum - 1) = "◎" Or vWK(RWNum, CLNum - 1) = "〒", 1, 0) wsWk.Cells(RWNum, "AL") = vToCK(RWNum, 当番日数) Next RWNum inputFmlAgain wsWk, rWK.Rows.Count - 7, CLNum With wsWk.Sort .SortFields.Clear .SortFields.Add Key:=wsWk.Range("AP8"), SortOn:=xlSortOnValues, _ Order:=xlAscending, DataOption:=xlSortNormal .SetRange wsWk.Range("AP7").Resize(rWK.Rows.Count - 6) .Header = xlYes .Apply End With Set rngSorted = wsWk.Range("AP1:AP" & lastRw) For Each kbn In Array("1", "2") cnt = 0 For RWNum = 8 To UBound(vToCK) If Left(rngSorted(RWNum, 1), 1) > "2" Then Exit For Else If Left(rngSorted(RWNum, 1), 1) = kbn Then rwHit = Val(Right(rngSorted(RWNum, 1), 2)) vWK(rwHit, CLNum) = IIf(kbn = "1", "◎", "〒") vToCK(rwHit, 当番日数) = vToCK(rwHit, 当番日数) + 1 cnt = cnt + 1 If cnt >= 2 Then Exit For End If End If End If Next RWNum Next kbn End If Next CLNum wsWk.Range("A1").Resize(UBound(vWK), UBound(vWK, 2)) = vWK '割振り予定(文字表示) 'シフト表を色付け Dim msgContinu As String For CLNum = target.Column To 34 For RWNum = 8 To lastRw If (vWK(RWNum, CLNum - 1) = "〒" And vWK(RWNum, CLNum) = "〒") Then msgContinu = msgContinu & vbCrLf & vWK(RWNum, 3) & "さん:" & Format(vWK(7, CLNum), "mm/dd") End If If vWK(RWNum, CLNum) = "◎" Then WsShift.Cells(RWNum, CLNum).Interior.Color = 65535 ElseIf vWK(RWNum, CLNum) = "〒" Then WsShift.Cells(RWNum, CLNum).Interior.Color = 5287936 End If Next RWNum Next CLNum Application.ScreenUpdating = True If msgContinu <> "" Then MsgBox "連続" & msgContinu Else MsgBox "連続当番なし" End If End Sub Private Sub inputFmlOnce(wsWk As Worksheet, RW As Long) wsWk.Range("AJ7:AM7").Value = Array("業務区分", "前回当番", "当番日数", "行番") wsWk.Range("AP7").Value = "SORT" wsWk.Range("AJ8").Resize(RW).FormulaLocal = "=FIND(LEFT(VLOOKUP(C8,社員リスト!A:B,2,FALSE)&""他""),""業郵他"")" wsWk.Range("AJ8").Resize(RW).Value = wsWk.Range("AJ8").Resize(RW).Value wsWk.Range("AM8").Value = 8 '行番号を振る wsWk.Range("AM8").AutoFill Destination:=wsWk.Range("AM8").Resize(RW), Type:=xlFillSeries End Sub Private Sub inputFmlAgain(wsWk As Worksheet, RW As Long, aimCol As Long) wsWk.Range("AP6").Value = aimCol wsWk.Range("AP8").Resize(RW).FormulaLocal = _ "=((IF(INDEX(A:AH,ROW(),AP$6)<>"""",6,0)+AJ8)*10+ak8)*10000+AL8*100+AM8" wsWk.Range("AP8").Resize(RW).Value = wsWk.Range("AP8").Resize(RW).Value End Sub Sub ボタン実行() Call JobAssignment(Worksheets("作業").Range("D7")) End Sub Sub 色のリセット() Dim CLNum As Long, RWNum As Long, lastRw As Long With Worksheets("シフト表") lastRw = .Cells(.Rows.Count, "C").End(xlUp).Row For CLNum = 4 To 34 For RWNum = 8 To lastRw If .Cells(RWNum, CLNum).Interior.Color <> 16774877 Then .Cells(RWNum, CLNum).Interior.Color = 16777215 End If Next RWNum Next CLNum End With End Sub （半平太） 2023/10/16(月) 17:22:27 ---- 半平太さんありがとうございます。問題なくテレワーク期間中の色が消えませんでした! ありがとうございます。ただ、13行目〜16行目の方がまったく当番が割り振られず、 12行目の方が連続して当番をすることになり、連番のポップアップが表示されました。さきほどテレワークを塗りつぶしていなかったときは、均等に割り振られていました。何故でしょうか? よろしくお願いいたします。（TKG） 2023/10/16(月) 17:37:57 ---- ↑訂正です。再度ためしてみたところ、テレワーク期間を設けなかった時も、 13〜16行目の方が当番が割り振られませんでした。（TKG） 2023/10/16(月) 17:44:20 ---- 半平太さん大変失礼いたしました。こちらのミスでした! すべてうまくいきました!! （TKG） 2023/10/16(月) 17:46:59 ---- ↑取り急ぎ更新いたしました。改めまして・・・半平太さん多忙な中、このように大変なものを作ってくださり、本当に感謝しております。願った通りのシフト表になり、業務が簡略化できます!! そしてポップアップするようにしてくださったおかげで、どこを修正したらいいかすぐにわかるので、手作業で微調整することもできるので、本当に助かりました。ありがとうございます! この投稿に助言をしてくださった皆様、ありがとうございました! 自分でマクロを試してみたのですが、未熟すぎる私は挫折の繰り返しで・・・。初投稿のため、なんども修正をいれるような投稿の書き方をしてしまい、気分を悪くさせてしまったと思います。今後もし、投稿することがあるときは、そこは十分に注意しようと思います。本当にありがとうございました。皆様の活躍を応援しております! （TKG） 2023/10/16(月) 17:59:01 ---- 半平太さん先ほどお礼をお伝えしたばかりですが・・・すみません。確認させてください! 月を変更したとき、型が違いますと表示されました。 10月で試した場合、31日まで日付がありますが、 11月の場合、30日までしかないので、 31日は表示されないようになっているからでしょうか。 7行目の日付欄は、 31のところは数式で =IF(DAY(DATE($D$1,$G$1,31))=31,31,"") と入力しております。 29・30も同様です。またご指導ください。よろしくお願いいたします。（TKG） 2023/10/16(月) 19:26:44 ---- 横道の話ですが、＞31のところは数式で＞=IF(DAY(DATE($D$1,$G$1,31))=31,31,"") AF7セルに =IF(DAY(DATE($D$1,$G$1,AF6))=AF6,DATE($D$1,$G$1,AF6),"") として、右にコピー(AH7まで）とする。 <シフト表結果図> 行 __AF__ __AG__ AH 6 29 30 31 7 11/29 11/30 さて、＞11月の場合、30日までしかないので、＞31日は表示されないようになっているからでしょうか。その問題は考慮済みですので、トラブらないハズです。型違いのエラーが出たのはプログラムのどの箇所なのか教えてください。（半平太） 2023/10/16(月) 19:45:54 ---- 半平太さんありがとうございます。数式なおしました。曜日のところが「###」になっております。曜日は以前お伝えした通り、=DATE($D$1,$G$1,AF7)と数式があり、書式設定で[aaa]と曜日に変換しております。それ以外は特にわかりません・・・。（TKG） 2023/10/16(月) 20:08:38 ---- ちょっとイメージ合わせが必要です。 AF6 と AF7 にはどんな数式が入っていますか? 今までの数式のことです。(それを後で変更してもらう運びになります。）（半平太） 2023/10/16(月) 20:39:16 ---- 半平太さん数式を直し、もう一度マクロを実行したところ、うまくいっています。 2024年2月にしてもなにもみられなくなりました。問題ないみたいです。ありがとうございます! （TKG） 2023/10/16(月) 20:56:08 ---- 何度も申し訳ありません。チェック当番を1人態勢にしたい場合や、郵便当番を3人態勢にしたい場合はどのように変更したらよろしいでしょうか。（TKG） 2023/10/16(月) 22:51:27 ---- 半平太さん質問です。なぜかD列・AE・AF・AG列の当番が配属されません。どのようにしたらよろしいでしょうか。チェック当番を1人体制にしたい場合や、郵便当番を3人体制にしたい場合も教えていただけると嬉しいです。（多忙期はエクセル自体を別につくります。）何度も申し訳ありませんが、どうかよろしくお願いいたします。（TKG） 2023/10/17(火) 08:06:32 ---- ＞チェック当番を1人態勢にしたい場合や、＞郵便当番を3人態勢にしたい場合はどのように変更したらよろしいでしょうか。これが出来ないと、使えないアプリですよね。ただ、いつもは22だが、その日は12とか、23とかにしたい事をエクセル君にどうやって伝えるかです。シフト表の最下行に、(仮に）指図さんを必ず入れることにして、 22じゃない日は「休」ならぬ「12」などを埋めてもらうとかですかね。こちらはシフト表全体がどうなっているのか分からないので、そちらのアイデア待ちです。＞なぜかD列・AE・AF・AG列の＞当番が配属されません。分からないです。土日祝じゃないんですか? 再現データを提示していただかないと分からないです。月の情報とD列の休情報だけでも提示できませんか? （半平太） 2023/10/17(火) 08:47:24 ---- ここでは OneDrive とか使ってサンプルファイルを共有するって誰もやってないようだけど、そもそも質問する人は概して（失礼な言い方になるけど）リテラシが低いからそんなことに思い至らないということなのかなぁ。（通りすがりの独り言） 2023/10/17(火) 09:27:57 ---- 回答者って、外部ファイルを気にしないでダウンロードしてくれるんでしょうか。私はリテラシーが低いので、あんまりウェルカムじゃないですが。（半平太） 2023/10/17(火) 10:19:53 ---- 半平太さん遅くなってしまい申し訳ありません。年や月を変えたときに、作業シートにうまく貼り付けができていなかったのが原因のようでした。今はうまくいっています。お騒がせしました・・・。うまくいくときといかないときがあるんでしょうか。チェック当番を1人体制や、郵便当番を3人体制に変える場合についてですが、多忙期については、月ごとで変わります。月途中から多忙ということもなく、月初から数か月間忙しくなります。多忙期のみ人を増員し、人数が5人程増員します。多忙期の業務チェックは2人になりますが、通常期は1人でも十分なときもあります。多忙期の郵便当番は大体3人体制になります。日ごとで人数が変わるということはなく、多忙期か通常期か（月ごと）でチェックの体制が変わります。ですから、毎年多忙期のときだけ使うシフト表が別に存在します。・・・といっても、型は通常期と全く変わりません。シフト表が2つあるような状態です。もしよろしければ、業務チェックや郵便当番の人数が変わった場合のコードを教えていただき、それをマクロの指定先に貼付することで変更できる・・・というような方法があれば教えていただきたいと思います。どうぞよろしくお願いします。（TKG） 2023/10/17(火) 19:45:32 ---- ＞年や月を変えたときに、作業シートにうまく貼り付けができていなかったのが＞原因のようでした。＞今はうまくいっています。＞うまくいくときといかないときがあるんでしょうか。ちょっと、意味が解らないです。作業シートへの貼付けはプログラムが自動的にやるので、人間が何か手を加える必要はないです。 ※作業シートに何かするのは止めてください。まぁ、何をやってもプログラムが上書きするので害にも薬にもなりませんが・・＞ですから、毎年多忙期のときだけ使うシフト表が別に存在します。＞・・・といっても、型は通常期と全く変わりません。それなら、何種類も作る必要はないです。開始と同時に何人体制か訊かれるので、それに応えればいいです。通常は、「22」とする。その他は、繁忙状態に合わせて、「12」、「23」、「13」とかを入れる。「JobAssignment」だけ、以下のコードと入れ替えてください。 Private Sub JobAssignment(target As Range) Dim WsShift As Worksheet, wsWk As Worksheet Dim rShift As Range Dim rWK As Range Dim vWK Dim vToCK() Dim lastRw As Long Dim RWNum As Long, CLNum As Long Dim rngSorted As Range Dim cnt As Long Dim kbn Dim rwHit As Long Dim Dy As Date Dim Hldy As Range Dim msgAlert As String, numOfAsgn, Limit As Long, deflT Set Hldy = Application.Range("祝日リスト") Set WsShift = Worksheets("シフト表") Set wsWk = Worksheets("作業") deflT = IIf(WsShift.Range("A1").ID = "", "22", WsShift.Range("A1").ID) numOfAsgn = InputBox("当番人数(左が業務チェック当番)", , deflT) If numOfAsgn = "" Then Exit Sub Else WsShift.Range("A1").ID = numOfAsgn End If 'シフト表の初期化 (テレワーク色のみ残す) With WsShift lastRw = .Cells(.Rows.Count, "C").End(xlUp).Row Set rShift = .Range("A1:AH1").Resize(lastRw) End With For CLNum = 4 To 34 For RWNum = 8 To lastRw If rShift(RWNum, CLNum).Interior.Color <> 16774877 Then rShift(RWNum, CLNum).Interior.Color = 16777215 End If Next RWNum Next CLNum '作業シートをクリア、シフト表を転記する wsWk.UsedRange.Clear rShift.Copy wsWk.Range("A1") Set rWK = wsWk.Range(rShift.Address) vWK = rWK.Value 'テレワーク色を文字化(♪）する For CLNum = 4 To 34 For RWNum = 8 To lastRw If rWK(RWNum, CLNum).Interior.Color = 16774877 Then vWK(RWNum, CLNum) = "♪" End If Next RWNum Next CLNum rWK.Value = vWK '現状文字化を作業シートに反映 'チェック用数式を入力 wsWk.Range("AP6") = target.Column inputFmlOnce wsWk, rWK.Rows.Count - 7 '8行目からが数式入力の為、マイナス7行とする ReDim vToCK(1 To UBound(vWK), 1 To 4) '割当本番 Application.ScreenUpdating = False For CLNum = target.Column To 34 '営業日チェック+空白対策 Dy = IIf(vWK(7, CLNum) = "", Application.WorkDay_Intl(vWK(7, 4), 1, "1111110"), vWK(7, CLNum)) If Application.NetworkDays(Dy, Dy, Hldy) = 1 Then '当番日数と前回当番を更新 For RWNum = 8 To UBound(vToCK) wsWk.Cells(RWNum, "AK") = IIf(vWK(RWNum, CLNum - 1) = "◎" Or vWK(RWNum, CLNum - 1) = "〒", 1, 0) wsWk.Cells(RWNum, "AL") = vToCK(RWNum, 当番日数) Next RWNum inputFmlAgain wsWk, rWK.Rows.Count - 7, CLNum With wsWk.Sort .SortFields.Clear .SortFields.Add Key:=wsWk.Range("AP8"), SortOn:=xlSortOnValues, _ Order:=xlAscending, DataOption:=xlSortNormal .SetRange wsWk.Range("AP7").Resize(rWK.Rows.Count - 6) .Header = xlYes .Apply End With Set rngSorted = wsWk.Range("AP1:AP" & lastRw) For Each kbn In Array("1", "2") cnt = 0 Limit = Val(IIf(kbn = "1", Left(numOfAsgn, 1), Right(numOfAsgn, 1))) For RWNum = 8 To UBound(vToCK) If Left(rngSorted(RWNum, 1), 1) > "2" Then If cnt < Limit Then msgAlert = msgAlert & vbCrLf & IIf(kbn = "1", "業務", "郵便") & "当番不足→ " & _ Limit & "名中 " & cnt & "名のみ割当 " & Format(vWK(7, CLNum), "mm/dd") End If Exit For Else If Left(rngSorted(RWNum, 1), 1) = kbn Then rwHit = Val(Right(rngSorted(RWNum, 1), 2)) vWK(rwHit, CLNum) = IIf(kbn = "1", "◎", "〒") vToCK(rwHit, 当番日数) = vToCK(rwHit, 当番日数) + 1 cnt = cnt + 1 If cnt >= Limit Then Exit For End If End If End If Next RWNum Next kbn End If Next CLNum wsWk.Range("A1").Resize(UBound(vWK), UBound(vWK, 2)) = vWK '割振り予定(文字表示) 'シフト表を色付け For CLNum = target.Column To 34 For RWNum = 8 To lastRw If (vWK(RWNum, CLNum - 1) = "〒" And vWK(RWNum, CLNum) = "〒") Then msgAlert = msgAlert & vbCrLf & vWK(RWNum, 3) & "さん連続:" & Format(vWK(7, CLNum), "mm/dd") End If If vWK(RWNum, CLNum) = "◎" Then WsShift.Cells(RWNum, CLNum).Interior.Color = 65535 ElseIf vWK(RWNum, CLNum) = "〒" Then WsShift.Cells(RWNum, CLNum).Interior.Color = 5287936 End If Next RWNum Next CLNum Application.ScreenUpdating = True If msgAlert <> "" Then '割当不足等のメッセージを出す。 MsgBox msgAlert Debug.Print msgAlert 'イミディエイトウィンドウにも書き出す Else MsgBox "連続当番なし" End If End Sub （半平太） 2023/10/17(火) 20:35:23 ---- 半平太さん早速の解決案をありがとうございます。＞作業シートに何かするのは止めてください。半平太さんのプログラムに手を加えるなんてこと、できやしませんし、プログラムが動かなくなっては困るのでさわっておりません。私はボタンを作り、ボタンでリセットができるようにしただけなので、もしかしたら、それが悪かったのかもしれません。何か原因があるのかと思い、作業のシートを確認したところ、うまくコピーがされていないようだったので、再度リセットし、実行したところです。そもそもリセットができていなかっただけかもしれません。お騒がせいたしました。そして・・・今試してみましたが、本当に解決できました!! ポップアップをだし、その通りに配分できるようになるなんて! いままでシフト表を2つ作っておりましたが、それも必要なくしてくださるなんて、本当に多忙な中、しつこい私の乏しい質問責めに（本当に申し訳なく思っております。）見放さず、解決してくださり、感謝しております。私がいろいろパニックになっているだけで、半平太さんは初めから最後まで見事でした。本当にありがとうございました。（TKG） 2023/10/17(火) 21:07:40 ---- 半平太さん先日は素晴らしいプログラムをありがとうございました。早速使っていたのですが、来月から当番が二つ（増すことになったのですが、そういった場合どのように訂正したらよろしいでしょうか。 A列 B列 C列あ業務チェックメールチェックい業務チェックメールチェック … た郵便在庫確認ち郵便在庫確認 ↑つまり、業務チェックができる方は、メールチェックも行うことになり、郵便当番は、在庫確認をすることになりました。それを1名ずつ体制ですることになりました。決算月が近い時はそういう当番にし、それ以外は今までのプログラミングでいいのですが、どのように修正したらよろしいでしょうか。申し訳ありませんが、ご教授お願いいたします! （今月ゴミ当番） 2023/10/24(火) 11:19:32 ---- ↑今月ゴミ当番様申し訳ありません。私はTKGです。ニックネームを同じような名前にしようと思い、新しく立ち上げようとしていたのですが、コピーしておいてそのまま更新してしまいました。勝手に使い、申し訳ございません。（今月ゴミ当番） 2023/10/24(火) 11:24:22 ---- ＞私はTKGです。なのに何故（今月ゴミ当番）としているのだろうか。ひょっとして同一人物? （?） 2023/10/24(火) 12:01:15 ---- 無難にRANDでやってみては... （ぴー） 2023/10/24(火) 12:38:03 ---- ちょっと質問が呑み込めないのですが、 (仕事は増えるが）1人ずつでやることになった訳ですよね? なら、開始と同時に何人体制か訊かれたとき、 11 と入れればいいだけだと思うのですが。。（半平太） 2023/10/24(火) 19:45:49 ---- 半平太さん一人ずつでやることになったのですが、今まで2色で対応していたものを、（黄色と緑） 4色にするにはどう修正したらいいでしょうか。業務チェック→◎ 郵便当番→〒 ↓ 業務チェック→◎ メールチェック→〇郵便当番→〒在庫確認→□ のように作業シートにいれ、色を変更はできないでしょうか。（TKG） 2023/10/24(火) 20:07:34 ---- ? さん自分でも再度間違えたことに気づいたのですが、もう戻せなかったのでそのままにしておりました。申し訳ないです。ピーさん RANDとはどういう方法でしょうか? よろしくお願いします。（TKG） 2023/10/24(火) 20:12:12 ---- ちょっと意味が解らないのですが、 1つのセルに2色出すと言うことなんですか? それは無理なんですが、私が質問内容を勘違いしているのかなぁ・・（半平太） 2023/10/24(火) 21:15:16 ---- 半平太さん 1つのセルに2色ではなく、担当が増えるということです。ただ、今までは業務チェックは先輩の中で1人とか2人、郵便は後輩の中から2人〜3人などでお願いしていたのですが、業務チェックとメールチェックを先輩の中から1人ずつ、郵便と在庫管理は、後輩の中から〒1人在庫一人、もしくは、〒2人と在庫1人と毎日担当することになったということです。どのように修正したらよろしいでしょうか。どうぞよろしくお願いいたします。（TKG） 2023/10/24(火) 22:13:15 ---- 後出し後出しで回答疲れているんじゃなかろうか。ご自愛ください。（閲覧者。） 2023/10/24(火) 22:27:34 ---- 閲覧者。様ご指摘通り、本当に申し訳なく思っております。ただ、従来の方法が変更となってしまい、困り果て、申し訳なく思いながらも、再度投稿させてもらいました。（TKG） 2023/10/24(火) 23:07:16 ---- そう言うことだったですか。一つ確認ですが、先輩なら誰でも、業務チェックとメールチェック、どっちでも処理できますね? 後輩なら誰でも、郵便と在庫管理、どっちでも処理できますね? それとも、どっちかしか出来ない先輩や後輩もいるんでしょうか? （半平太） 2023/10/24(火) 23:09:31 ---- 半平太さんその通りでございます。先輩全員処理できるわけではなく、業務チェックは全員できますが、メールチェックは、まだ勉強中の先輩がいます。後輩は両方できます。 A列 B列 C列あ業務チェックメールチェックい業務チェック … た郵便在庫確認ち郵便在庫確認（TKG） 2023/10/25(水) 00:21:12 ---- ＞メールチェックは、まだ勉強中の先輩がいます。そうですか・・とほほ最初は簡単にできそうじゃん、と思って仕掛けをお手軽版で作ったんですが、さすがにこの段階で破綻しました。＞業務チェック→◎ ＞メールチェック→〇＞郵便当番→〒＞在庫確認→□ ＞のように作業シートにいれ、色を変更はできないでしょうか。それで、追加になった○と□に対応する「色」はどうするんですか? 色コード(Interior.Color)で教えてください。（半平太） 2023/10/25(水) 20:23:41 ---- 半平太さん（先輩）業務チェック→◎→65535 （先輩）メールチェック→〇（後輩）郵便当番→〒→5287936 （後輩）在庫確認→□→9946051 メールチェックのinterior.colorは、ない方がいいと思っております。＞最初は簡単にできそうじゃん、と思って仕掛けをお手軽版で作ったんですが、すごいですね! 難しいことばかりいいまして本当に申し訳ありません。本当にお手数をおかけしますが、教えてください。どうぞよろしくお願いします。（TKG） 2023/10/25(水) 21:04:54 ---- 4当番専用です。今迄のとは別名のブックで管理してください。元に戻すのは「resetToOriginal」です。 ※「色のリセット」ではありません。色だけじゃなく○も消さないとならないので実行方法は同じですが、当番の人数の指定は、4桁になります。 ※業務1、メール1、郵便1、在庫2人なら「1112」となります。 Enum col 業務区分 = 1 前回当番当番日数行番決定 End Enum Private Sub Worksheet_BeforeRightClick(ByVal target As Range, Cancel As Boolean) If target.Address(0, 0) = "D7" Then Cancel = True Call JobAssignment(target) End If End Sub '「作業」シートを1枚挿入して置く---------------------------------- Private Sub JobAssignment(target As Range) Dim WsShift As Worksheet, wsWk As Worksheet Dim rShift As Range Dim rWK As Range Dim vWK Dim vToCK() Dim lastRW As Long Dim RWNum As Long, CLNum As Long Dim rngSorted As Range Dim cnt As Long Dim kbn Dim rwHit As Long Dim Dy As Date Dim Hldy As Range Dim msgAlert As String, numOfAsgn, Limit As Long, deflT Dim msgTemp As String Set Hldy = Application.Range("祝日リスト") Set WsShift = Worksheets("シフト表") Set wsWk = Worksheets("作業") deflT = IIf(WsShift.Range("A1").ID = "", "1111", WsShift.Range("A1").ID) numOfAsgn = InputBox("業務、メール、郵便、在庫の順に人数を指定)", , deflT) If numOfAsgn = "" Then Exit Sub Else WsShift.Range("A1").ID = numOfAsgn End If 'シフト表の初期化 (テレワーク色のみ残す) With WsShift lastRW = .Cells(.Rows.Count, "C").End(xlUp).Row Set rShift = .Range("A1:AH1").Resize(lastRW) End With For CLNum = 4 To 34 For RWNum = 8 To lastRW If rShift(RWNum, CLNum).Interior.Color <> 16774877 Then rShift(RWNum, CLNum).Interior.Color = 16777215 End If Next RWNum Next CLNum '作業シートをクリア、シフト表を転記する wsWk.UsedRange.Clear rShift.Copy wsWk.Range("A1") Set rWK = wsWk.Range(rShift.Address) vWK = rWK.Value 'テレワーク色を文字化(♪）する For CLNum = 4 To 34 For RWNum = 8 To lastRW If rWK(RWNum, CLNum).Interior.Color = 16774877 Then vWK(RWNum, CLNum) = "♪" End If Next RWNum Next CLNum rWK.Value = vWK 'オリジナル状態を文字化した表を作業シートに反映 'チェック用数式を入力 wsWk.Range("AP6") = target.Column inputFmlOnce wsWk, rWK.Rows.Count - 7 '8行目からが数式入力の為、マイナス7行とする ReDim vToCK(1 To UBound(vWK), 1 To 5) Set rngSorted = wsWk.Range("AP1:AP" & lastRW) '割当本番 Application.ScreenUpdating = False For CLNum = target.Column To 34 '営業日チェック+空白対策 Dy = IIf(vWK(7, CLNum) = "", Application.WorkDay_Intl(vWK(7, 4), 1, "1111110"), vWK(7, CLNum)) If Application.NetworkDays(Dy, Dy, Hldy) = 1 Then '当番日数と前回当番を更新 For RWNum = 8 To UBound(vToCK) Select Case vWK(RWNum, CLNum - 1) Case "◎", "○", "〒", "□": wsWk.Cells(RWNum, "AK") = 1 End Select wsWk.Cells(RWNum, "AL") = vToCK(RWNum, 当番日数) wsWk.Cells(RWNum, "AN") = vToCK(RWNum, 決定) Next RWNum rngSorted.Offset(7, -2).ClearContents '本日実績事前消去 inputFmlAgain wsWk, rWK.Rows.Count - 7, CLNum For Each kbn In Array("2", "1", "3", "4") With wsWk.Sort .SortFields.Clear .SortFields.Add Key:=wsWk.Range("AP8"), SortOn:=xlSortOnValues, _ Order:=xlAscending, DataOption:=xlSortNormal .SetRange wsWk.Range("AP7").Resize(rWK.Rows.Count - 6) .Header = xlYes .Apply End With '業務の区分別にリミットを設定する Limit = Mid(numOfAsgn, kbn, 1) cnt = 0 For RWNum = 8 To UBound(vToCK) If Left(rngSorted(RWNum, 1), 1) = "Z" Or Mid(rngSorted(RWNum, 1), 3, 1) > "2" Then If cnt < Limit Then Select Case kbn Case "1": msgTemp = "業務" Case "2": msgTemp = "メール" Case "3": msgTemp = "郵便" Case "4": msgTemp = "在庫" End Select msgAlert = msgAlert & vbCrLf & msgTemp & "の当番不足→ " & _ Limit & "名中 " & cnt & "名のみ割当 " & Format(vWK(7, CLNum), "mm/dd") End If Exit For Else If Mid(rngSorted(RWNum, 1), 3, 1) = Int((kbn + 1) / 2) & "" Then rwHit = Val(Right(rngSorted(RWNum, 1), 2)) Select Case kbn Case "1": vWK(rwHit, CLNum) = "◎" Case "2": vWK(rwHit, CLNum) = "○" Case "3": vWK(rwHit, CLNum) = "〒" Case "4": vWK(rwHit, CLNum) = "□" End Select rWK.Cells(rwHit, "AN") = 1 vToCK(rwHit, 決定) = vToCK(rwHit, 決定) + 1 vToCK(rwHit, 当番日数) = vToCK(rwHit, 当番日数) + 1 cnt = cnt + 1 If cnt >= Limit Then Exit For End If End If End If Next RWNum inputFmlAgain wsWk, rWK.Rows.Count - 7, CLNum Next kbn End If Next CLNum wsWk.Range("A1").Resize(UBound(vWK), UBound(vWK, 2)) = vWK '割振り予定(文字表示) 'Stop 'シフト表を色付け For CLNum = target.Column To 34 For RWNum = 8 To lastRW If (vWK(RWNum, CLNum - 1) = "〒" And vWK(RWNum, CLNum) = "〒") Then msgAlert = msgAlert & vbCrLf & vWK(RWNum, 3) & "さん連続:" & Format(vWK(7, CLNum), "mm/dd") End If If vWK(RWNum, CLNum) = "◎" Then WsShift.Cells(RWNum, CLNum).Interior.Color = 65535 ElseIf vWK(RWNum, CLNum) = "○" Then WsShift.Cells(RWNum, CLNum).Formula = "=""○""" '数式の形で出す ElseIf vWK(RWNum, CLNum) = "〒" Then WsShift.Cells(RWNum, CLNum).Interior.Color = 5287936 ElseIf vWK(RWNum, CLNum) = "□" Then WsShift.Cells(RWNum, CLNum).Interior.Color = 9946051 End If Next RWNum Next CLNum Application.ScreenUpdating = True If msgAlert <> "" Then '割当不足等のメッセージを出す。 MsgBox msgAlert Debug.Print msgAlert 'イミディエイトウィンドウにも書き出す Else MsgBox "連続当番なし" End If End Sub Private Sub inputFmlOnce(wsWk As Worksheet, RW As Long) wsWk.Range("AJ7:AN7").Value = Array("業務区分", "前回当番", "当番日数", "行番", "決定") wsWk.Range("AP7").Value = "SORT" wsWk.Range("AJ8").Resize(RW).FormulaLocal = _ "=FIND(LEFT(VLOOKUP(C8,社員リスト!A:B,2,FALSE)&""他""),""業郵他"")*10+FIND(LEFT(VLOOKUP(C8,社員リスト!A:C,3,FALSE)&""他""),""メ在他"")" wsWk.Range("AJ8").Resize(RW).Value = wsWk.Range("AJ8").Resize(RW).Value wsWk.Range("AM8").Value = 8 '行番号を振る wsWk.Range("AM8").AutoFill Destination:=wsWk.Range("AM8").Resize(RW), Type:=xlFillSeries End Sub Private Sub inputFmlAgain(wsWk As Worksheet, RW As Long, aimCol As Long) wsWk.Range("AP6").Value = aimCol wsWk.Range("AP8").Resize(RW).FormulaLocal = _ "=(IF(OR(INDEX(A8:AH8,AP$6)<>"""",AN8),""Z"",""A"")&AN8*1)&(((IF(INDEX(A:AH,ROW(),AP$6)<>"""",6,0)+AJ8)*10+AK8)*10000+AL8*100+AM8)" wsWk.Range("AP8").Resize(RW).Value = wsWk.Range("AP8").Resize(RW).Value End Sub Sub ボタン実行() Call JobAssignment(Worksheets("作業").Range("D7")) End Sub Sub resetToOriginal() Dim CLNum As Long, RWNum As Long, lastRW As Long Dim aCL As Range, App As Application Set App = Application With Worksheets("シフト表") On Error Resume Next Intersect(.UsedRange, .Range("A8:AH100")).SpecialCells(xlCellTypeFormulas, 23).ClearContents On Error GoTo 0 lastRW = .Cells(.Rows.Count, "C").End(xlUp).Row For CLNum = 4 To 34 For RWNum = 8 To lastRW If .Cells(RWNum, CLNum).Interior.Color <> 16774877 Then .Cells(RWNum, CLNum).Interior.Color = 16777215 End If Next RWNum Next CLNum End With End Sub （半平太） 2023/10/25(水) 22:54:05 ---- 半平太さん素晴らしいプログラムを組んで下さり、ありがとうございます! 本当に感謝しています! これから来月の予定を組もうというときに、突然の変更で本当に困っていました。先日お願いしたばかりなので、申し訳なく思い、新しく投稿しようかと悩みましたが、正直に投稿することにしました。ご親切にありがとうございます。こんなに早くに、本当に助かりました。ありがとうございます! 明日本物を使用し、再確認したいと思います。ありがとうございます! （TKG） 2023/10/25(水) 23:59:12 ---- 半平太さん実行すると、テレワーク部分の色が消え、テレワークの方も当番として割り当てられてしまいました。リセットをいたしますと、先ほど割り当てられた「〇」と社員名がすべて消え、割り振られた当番の色の部分は残っておりました。（社員名は社員リストから名前がリンクされております。）どのようにしたらよろしいでしょうか。どうぞよろしくお願いいたします。（TKG） 2023/10/26(木) 06:24:34 ---- 半平太さんメールチェック→◯→青←何色でも大丈夫です。テレワークとかぶらなければ。そうしたら、複雑にならずうまくいくでしょうか? （TKG） 2023/10/26(木) 08:26:53 ---- すみません。やっつけ仕事になっています・・m(__)m 1. 「Private Sub JobAssignment(target As Range)」の中の以下の部分を変更してください。＞ 'シフト表の初期化 (テレワーク色のみ残す) ＞ With WsShift ＞ lastRW = .Cells(.Rows.Count, "C").End(xlUp).Row ＞ Set rShift = .Range("A1:AH1").Resize(lastRW) ＞ End With ＞＞ For CLNum = 4 To 34 ＞ For RWNum = 8 To lastRW ＞ If rShift(RWNum, CLNum).Interior.Color <> 16774877 Then ＞ rShift(RWNum, CLNum).Interior.Color = 16777215 ＞ End If ＞ Next RWNum ＞ Next CLNum ↓上記を下記に変更 ' 'シフト表の初期化 (テレワーク色を残し、○は消す) With WsShift lastRW = .Cells(.Rows.Count, "C").End(xlUp).Row Set rShift = .Range("A1:AH1").Resize(lastRW) End With resetToOriginal ※あと、連続の警告は正しくないと気づきました。 (単に前日しか見ていないので、休日マタギは絶対に連続判定になりません。）・・が、修正する予定は今の所ありません。m(__)m ＞実行すると、テレワーク部分の色が消え、 2.そこはちょっと思い当たりません。ここで、テレワークの色(16774877）は消さない様にしているはずなんですが・・ ↓ ＞ If rShift(RWNum, CLNum).Interior.Color <> 16774877 Then （半平太） 2023/10/26(木) 08:42:39 ---- 半平太さんありがとうございます。それぞれの当番が均等になるようにはできないでしょうか。連続の警告については問題ありません。大丈夫です。テレワーク部分を残すことも、確認したところ、うまくできました。ありがとうございます。本当にお手数をおかけいたしますが、どうぞよろしくお願いいたします。（TKG） 2023/10/26(木) 19:26:30 ---- ＞それぞれの当番が均等になるようには＞できないでしょうか。先述しました様に、そもそも骨格がお手軽版なので細かい条件が付くと対応できる代物ではありません。他の回答者のレスをお待ちください。（ぴー）さんが、RANDで無難にやってくれるといいのですが・・（半平太） 2023/10/26(木) 20:23:28 ---- 半平太さん承知いたしました。本当にありがとうございます。（TKG） 2023/10/26(木) 21:11:56 ...; https://www.excel.studio-kazu.jp/wiki/kazuwiki/202310/20231014175401.txt - [detail] - similar

PREV NEXT

訪問者：カウンタ