エクセルの学校：全文検索：Hyper Estraier：リスト

Results of 1 - 1 of about 8932 for リスト (0.006 sec.)

[[20231020232949]]: #score: 2746; @digest: 04de3cc1e81d2d8374a78130b7ae85ae; @id: 95345; @mdate: 2023-11-16T00:42:33Z; @size: 69159; @type: text/plain; #keywords: wswk (279303), clnum (234793), vnumck (226279), strtosort (224072), 外リ (193279), 消毒 (190365), 話当 (178187), 当番 (168224), wsshift (144596), nativerw (141370), vwk (132923), 月ゴ (130135), rwnum (113781), ミ当 (110378), 給湯 (88692), lastrw (83183), 江口 (76787), msgalert (72185), 骨折 (70544), 水増 (65938), 安藤 (58727), 在宅 (44546), 電話 (37698), 除外 (29956), トイ (29816), イレ (27464), 文句 (26362), 掃除 (24390), 早退 (24216), ト表 (23997), 午前 (22154), シフ (21380); 『当番の割り当て』（今月ゴミ当番）
月末近くに、土日祝日や有休（遅刻、早退など）を考慮して掃除当番を割り当てたあと、電話当番を割り当てています。('◇')ゞ勤務表（土日祝日は入力しないように色をかえています）に個人の希望している休みなどを前もって入力してあります。 A B C D E F G H 1 10月 1 2 3 4 5 … 2 社員日月火水木 3 安藤休遅 4 伊藤休 5 内村早 6 江口 … 人数は15人ほど。掃除当番は、給湯室掃除、トイレ掃除、会議室掃除、消毒の4種類あり、毎日それぞれ1人ずつ当番を手作業で割り当てています。 A B C D E F G H 1 10月 1 2 3 4 5 … 2 社員日月火水木 3 安藤休遅 T 4 伊藤湯休 5 内村消早 6 江口 T 会 … 当番は色別で表示しておりますが、トイレだけは「T」と表示する決まりです。（わたしはその表現を変えられるような立場にありません）ここではわかりやすく消毒は「消」、会議室は「会」、給湯室は「湯」、トイレは「T」としています。そこまでは手作業でも、まぁ・・いいのですが・・(-"-) 問題は、その割り当てが終わったあとに電話当番を割り当てているので、相当時間がかかってます。(´;ω;`) 電話当番はセルを青で表示しています。遅刻(12:00まで)の方は、午後からの電話当番ができる。早退(13:00から）の方は、午前に電話当番ができる。遅刻もお昼過ぎたり、早退も午前中早退の方も極稀にいるので、当番を割り当てる前にすでに予定として決まっている方は、当番を割り当てないようにしています。その他に、トイレ掃除の当番の方は電話当番免除、消毒当番は午後から消毒なので、午前中の電話当番ができる。そういった決まり事を考えながら、電話当番は午前3名、午後3名と割り当てるので、平等に均等に割り当てると・・・(一一") 頭がパンクします。しかも女ばかりの職場なので、平等でないと文句が・・・。掃除も電話も嫌なのわかりますけど・・・。何かいい方法はないでしょうか。関数をあてはめるとか・・・。マクロは一度しかやったことがないのですが、何か方法があるなら、頑張ります。どうかお願いします!! ＜使用 Excel:Excel2019、使用 OS:Windows11 ＞ ---- 1.何処かに祝日リストは作ってありますか? 2.A列に連番があるようですが、行番号とまったく同じですか? それとも、1と書かれているセルは、シートの1行目じゃないですか 3.その連番はスタッフの名前の最終行までピッタリ入っているんですか? それともそれ以上の番号も振ってあるのですか? 4.割り当てリストに、当番をやらない人の名前も載ってたりするんでしょうか? 5.当番はどんな色分けなんですか? 午前の電話と消毒の当番を兼ねる人は、一体何色になるんですか? ＞そこまでは手作業でも、まぁ・・いいのですが・・(-"-) 6.ホント? 7.「極稀遅刻・早退」と「普通遅刻・早退」とは、どう見分けるのですか? 8.当番の種類を嫌な順に並べるとどんな感じになりますか? 例: T＞電＞消・湯＞会 (消毒と給湯はおなじ位）＞ 10月 1 2 3 4 5 … ＞社員日月火水木 9. 1・・・5とかは、単なる数値なんですか? それとも、実際は日付シリアル値(例:2023/10/1）なんですか? 小の月(例:2月）の月末の右隣のセルはどうなっていますか? 上記の表の「10月」の実体が「2023/10/1」だったりしますか? （半平太） 2023/10/21(土) 10:33:54 ---- <追加> 電話は、午前と午後があるようですが、どっちが嫌ですか（それとも同じ?）（半平太） 2023/10/21(土) 10:41:45 ---- 半平太さんこんにちは。よろしくお願いします!!<(_ _)> 1.何処かに祝日リストは作ってありますか? 祝日リストはシートが別に作ってあります。 A1に休日の名前、B1に日にちが入っていて、 リストになっています。 2.A列に連番があるようですが、行番号とまったく同じですか? それとも、1と書かれているセルは、シートの1行目じゃないですか本当ですね・・・。行番号のつもりでしたけど、社員名のまえにも1とかいてありました・・。正しくは、 A B C D E F G H 1 10月 1 2 3 4 5 … 2 社員日月火水木 3 1 安藤休遅 T 4 2 伊藤湯休 5 3 内村消早 6 4 江口 T 会 ↑これです。失礼いたしました～m(__)m 3.その連番はスタッフの名前の最終行までピッタリ入っているんですか? それともそれ以上の番号も振ってあるのですか? 今はスタッフの名前の最終行までピッタリ入っています。人が増減するときは、行を挿入したり削除したりしています。社員リスト化して、表は動かさずにした方がいいですかねー。うーん・・・。(-"-) 4.割り当てリストに、当番をやらない人の名前も載ってたりするんでしょうか? おお!! すばらしいところに気づかれるのですね!(@_@;) 勤務表には当番をされないお偉い人の名前もあるんですけど、私が当番を作成するときは、まず勤務表を別のシートにコピーして貼り付けて、当番をしない人を心置きなく削除しています。以前、足を骨折した人がいて、どうにもできないのでその人には給湯室を毎日割り当ててたことがあります。たとえば、そういうイレギュラーがでたときに、風邪で咳がひどいみたいな人に、消毒してもらうわけにいかないですし、「指定」みたいなことってできますか? たとえば、社員リストみたいなのをつくって、 1 安藤給湯 2 伊藤トイレ、会議室、消毒 3 内村トイレ、会議室、消毒 4 江口トイレ、会議室たとえば、安藤さんが足を骨折していたとして、給湯室しかできないってときは、給湯室を毎日当番としてしてもらう。他の人のリストから給湯室は省いたリストを作る江口さんは、咳がひどいから消毒はやめてもらいたいから、消毒以外の当番・・・みたいな感じで整理してつくって、当番を配置する・・・というようなのはどうでしょうか・・。 5.当番はどんな色分けなんですか? 午前の電話と消毒の当番を兼ねる人は、一体何色になるんですか? あー・・・肝心なことを言い忘れておりました。ごめんなさーーい!!m(__)mm(__)mm(__)m 電話当番の表は別のシートにつくっております。 A B C D E F G 1 日付午前 / 午後 2 10/1 安藤伊藤内村 / 江口小田加藤 3 10/2 岸田工藤今野 / 佐藤新藤菅田 ↑みたいな感じです。あ、こんなふうにきれいに五十音順でならんでません。ランダムです! 電話当番は青で表示しているのですが、午前の人はセル青の白文字、午後の人は白でした。なんのためにだれがそういう風につくったのかさっぱりわかりません。おしゃれ?? おしゃれか??? 新しく作り直したといって、青にする必要はないように思います!! ＞そこまでは手作業でも、まぁ・・いいのですが・・(-"-) 6.ホント? ・・・うっ・・・(@_@;) 本当はめんどくさい・・・(T_T) 7.「極稀遅刻・早退」と「普通遅刻・早退」とは、どう見分けるのですか? 勤務表の31日の右の列、要はあいているところに、早退11:00～とか早退15:00～とか遅刻 10:00出社とか書いてます。特に統一されていないですが、統一した方が、もしも・・もしも楽になるなら、シフト表に遅刻欄、早退欄を設けて、シフト表に「遅」の文字がはいったときは、時間だけ記入してもらうとか。 8.当番の種類を嫌な順に並べるとどんな感じになりますか? 例: T＞電＞消・湯＞会 (消毒と給湯はおなじ位） T＞消毒＞会＞給湯ですかね。私の意見ですが。消毒当番は、拭き掃除と液の補充とか、布巾の消毒とか地味に面倒くさいんですよねー。＞ 10月 1 2 3 4 5 … ＞社員日月火水木 9. 1・・・5とかは、単なる数値なんですか? それとも、実際は日付シリアル値(例:2023/10/1）なんですか? ただの数値です。小の月(例:2月）の月末の右隣のセルはどうなっていますか? 今確認したら・・・月初は、 =date(2023,B$1,C1)って入力されていて、書式設定で"aaa"となっていました・・・。（・・・だれだ、この表を作ったやつは・・怒）月末も同じです。なので、30日までしかない時は31日を消しています。上記の表の「10月」の実体が「2023/10/1」だったりしますか? ただの「10」で書式設定で”月”をたしている感じですね・・。（・・・・だれだ、この表を・・・怒怒） <追加> 電話は、午前と午後があるようですが、どっちが嫌ですか（それとも同じ?）どっちも嫌ですね。(・ω・)キッパリ・・ど、どうぞよろしくお願いしますっっ!! （今月ゴミ当番） 2023/10/21(土) 12:30:25 ---- 1.当番種の色はそれぞれ何色でしょうか? 言葉では厳密性に欠けますので、色コードでお願いします。イミディエイトウィンドウで、「? Range("D3").interior.color」 (例:色を着けたセルがD3の場合) として表示される数値です。 2.電話当番とそれ以外の当番の関係がちょっと分からないです。遅刻は、電話午後可 (但し、極遅は不可）早退は、電話午前可 (但し、極早は不可) Tは、不可消毒は電話午前可無当番電話(午前・午後いずれか可) との事ですが、無当番を優先的に電話にするんでしょうか? それとも、無当番の人が他に居るか否かは気にしないで、電話にしていいんでしょうか?(それで文句は出ない?）文句が出るなら、他の当番(特にトイレ当番)と同じ意味なので、一緒に割り振ればいいと思えちゃうのですが。他の当番を決めてから、電話当番だけ後回しにする意味って、特にあるんでしょうか? 別表にする、と言うは分かりましたが、それはあくまで結果表示の話なので、割振り手順を制限するものでもないと思うのですが。特に機械で当番を全部決める場合においてはの感覚なんですけど、何か二度手間な気がするんですよ。まぁ、実際にやってみないとホントかどうか分からないですが。（半平太） 2023/10/22(日) 08:06:59 ---- 1.当番種の色はそれぞれ何色でしょうか? 言葉では厳密性に欠けますので、色コードでお願いします。イミディエイトウィンドウで、「? Range("D3").interior.color」 (例:色を着けたセルがD3の場合) として表示される数値です。トイレ→65585で、「ト」の文字つき給湯→13408767 会議室→14348258 消毒→1408324 2.電話当番とそれ以外の当番の関係がちょっと分からないです。遅刻は、電話午後可 (但し、極遅は不可）早退は、電話午前可 (但し、極早は不可) Tは、不可消毒は電話午前可無当番電話(午前・午後いずれか可) との事ですが、無当番を優先的に電話にするんでしょうか? 無当番の方が優先ですが、遅刻や早退の方も電話当番として割り振られてます。先日例にあげた、安藤さんが足を怪我した場合ですが、電話当番に割り当てませんでした。電話相手を待たせてはいけないから（移動が不自由のため）。今妊娠している人がいて、いずれ産休になるのか辞めるのかわかりませんが、できないお当番や業務もでてくると思うので、電話当番オンリーということになるかもという噂もあります。・・・むずかしいなー。やっぱり先日みたいに、社員リストを作って、 A B C D E F 1 社員給湯トイレ会議室消毒電話NG期間 2 安藤〇 10/1～10/25 3 伊藤〇〇〇 4 内村〇〇〇 5 江口〇〇 10/25 6 小田フルみたいにつくって、当番を割り当てるようにしてみるとかどうでしょうか?? NGの欄に電話って書いてある人は、電話当番をその時期は割り振れない・・とか。シフト表に遅刻と早退とある人は、午前・午後わかれるが、電話当番になる。当番表?社員リスト?の電話当番だけは早退や遅刻のときに見づらくなるので、別のシートになるように・・とか。これはどうしてもこれといっているわけではなく、あくまでも、私のチープな案です。ちなみに↑上の例の小田さんは、何にもしない人です。出向とか。（そんなのないけど）私も引き継いだ時、当番を割り当てた後に電話当番をきめていくときいたときに、二度手間、途方に暮れる・・・と思ったんですけど、(-"-) 遅刻や早退の方を電話当番にあてたり、在宅勤務の人（介護中・シフト表には”在”と表示）もいるので、在宅でない時を考慮して電話当番をきめているからといわれたり、例えば、さっき例にあげた「安藤さんが足を怪我した場合」も、申し訳なさそうに給湯当番を毎日していたので、電話当番はなしにしてあげてたり… （文句はでていましたが、その時割り当てた人は無視してました）そのときは、納得したんですが・・・。やっぱり、半平太さんも「二度手間」だと思いますよね。(￣д￣) 一発でできる方法があれば!!(*‘ω‘ *)ワクワク本当に面倒くさいんです・・・(-"-) どうか、よろしくおねがいします!! （今月ゴミ当番） 2023/10/22(日) 10:49:55 ---- ↑ ×消毒→1408324 〇消毒→14083324 （今月ゴミ当番） 2023/10/22(日) 10:51:00 ---- 1.シートを3枚追加してください。シート名は、「作業」「除外リスト」「電話当番」 2.シフト表のB1セルには、月初を入れてください。。(例:2023/10/1）表示形式は任意です。 3.C2セルには、=IF($B1-1+C1<=EOMONTH($B1,0),$B1-1+C1,"") と入れ、 AG2セルまでコピーしてください。(表示形式は任意ですが、aaa になるでしょうね） 4.祝日リストは、「祝日リスト」と名前定義してあるものとします。日付と空白セルの部分だけにしてください(文字データは絶対に含めない→例:元日と書いたセル) 5.極稀早退・遅刻は、「早々」「遅々」と2文字入力してください。＞やっぱり先日みたいに、社員リストを作って、＞:: ＞当番を割り当てるようにしてみるとかどうでしょうか?? 下記の「除外リスト」とします。(B列の備考欄は単なるメモ。プログラムでは利用しません) <除外リスト>シート行 __A__ _____B_____ __________C__________ _____D_____ ___E___ 1 から1 から2 から3 2 社員備考 2023/10/1 2023/10/25 3 安藤骨折治療中トイレ、会議室、消毒 ←つまり安藤さんは10/24まで骨折、25日に完全復帰 4 江口風邪消毒消毒 ←江口さんは、とばっちりで再度「消毒」と書く必要がある ※(1)「から1」は必ず月初にしたいので、強制的にプログラムでシフト表のB1セルを参照させる数式を埋め込みます。 ※(2)「まで」の指定はできませんが、代わりに「から2」に"までの翌日"を入れ、当番欄を空白にすることで同じ意味にします。このため、その日付に何の関係ない人は、今迄と同じ除外当番名を入れなければならなくはなります。（例:江口氏） ※(3)なお、お偉いさんはここに書かず、予定表にハイフン「-」を埋めて貰って、割振り不可の人とします。 ※(4)除外リストの対象者がゼロても、2行目までは書き込んだ形で常駐させる必要があります。 ※(5)電話当番で、午前・午後を区別したいときは、午前を「電」の一字、午後を「話」の一字で入力してください。 6.プログラムの実行は、シフト表のC2セルを右クリックするか、プログラム名「Main」を手動実行してください。 7.シフト表をオリジナル状態に戻したいときは、プログラム名「resetToOriginal」を実行してください。 8.後記VBAは、シフト表のシートモジュールにコピペしてください。(標準モジュールではない(重要）） 9.コピペするVBAコード Enum COL '使うシーンは、ほぼ無い済 = 1 総ト電話消会給 End Enum Private Sub Worksheet_BeforeRightClick(ByVal target As Range, Cancel As Boolean) If target.Address(0, 0) = "C2" Then Cancel = True Call JobAssignment(target) End If End Sub Sub Main() Call JobAssignment(Worksheets("作業").Range("C2")) End Sub '[作業]シートと[除外リスト]シートを1枚挿入して置く Private Sub JobAssignment(target As Range) Dim WsShift As Worksheet, wsWk As Worksheet, wsTel As Worksheet Dim rWK As Range Dim vWK Dim vNumCK() Dim vNGCK() 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 Dim i As Long, k As Long, rr As Long, M As Long, Limit As Long Dim nativeRw As Long Dim strToSort() Dim Tel, temp(1 To 9) Dim dicT As Object Set Hldy = Application.Range("祝日リスト") Set WsShift = Worksheets("シフト表") Set wsWk = Worksheets("作業") Set wsTel = Worksheets("電話当番") Set dicT = CreateObject("Scripting.Dictionary") wsWk.UsedRange.Clear 'シフト表("A:AH")を作業シートに転記する Call resetToOriginal 'シフト表を初期状態に戻す Intersect(WsShift.UsedRange, WsShift.Range("A1:AG100")).Copy wsWk.Range("A1") With wsWk 'AG列までデータを格納 lastRw = wsWk.Cells(.Rows.Count, "B").End(xlUp).Row Set rWK = .Range("A1:A" & lastRw).Resize(, 33) vWK = rWK.Value End With 'チェック用数式の入力と監視用配列の確保 wsWk.Range("BB1") = target.Column inputFmlOnce wsWk, rWK.Rows.Count - 2 '3行目からが数式入力の為、マイナス2行とする vNumCK = rWK.Range("AI1:AP1").Resize(lastRw).Value vNGCK = rWK.Range("AQ1:AX1").Resize(lastRw).Value '割当本番-------------------------------- Application.ScreenUpdating = False For CLNum = target.Column To 33 '営業日チェック If vWK(2, CLNum) <> "" Then Dy = vWK(2, CLNum) '2行目の曜日から日付を取得 If Application.NetworkDays(Dy, Dy, Hldy) = 1 Then '平日なら wsWk.Range("BB1") = CLNum '対象列を記入 If CLNum > 3 Then '除外リストのアップデート要 If IsNumeric(Application.Match(rWK.Cells(2, rWK.Range("BB1").Value), _ Worksheets("除外リスト").Range("A2:AG2"), 0)) Then inputFmlUpdate wsWk, rWK.Rows.Count - 2 vNGCK = rWK.Range("AQ1:AX1").Resize(lastRw).Value End If End If For i = 1 To 6 'ト-電-話-消-会-給 kbn = Mid("ト電話消会給", i, 1) 'wsWk.Cells(1, "AI").Resize(lastRw, 6) = vNumCK '視認の為 ReDim strToSort(3 To lastRw, 1 To 1) '優先順項目作成 For rr = 3 To lastRw strToSort(rr, 1) = IIf(Len(vWK(rr, CLNum)) >= 1, "Y", "A") Select Case kbn Case "電" If InStr(vWK(rr, CLNum), "遅") Then strToSort(rr, 1) = "Z" End If Case "話" If InStr(vWK(rr, CLNum), "早") Then strToSort(rr, 1) = "Z" ElseIf InStr(vNumCK(rr, i), "電") Then strToSort(rr, 1) = "Z" ElseIf InStr(vNumCK(rr, i), "消") Then strToSort(rr, 1) = "Z" End If End Select Select Case vWK(rr, rWK.Range("BB1").Value) Case "休", "早々", "遅々", "-" strToSort(rr, 1) = "Z" Case "早", "遅" strToSort(rr, 1) = "X" End Select If vNGCK(rr, i + 2) = "Z" Then strToSort(rr, 1) = "Z" End If strToSort(rr, 1) = strToSort(rr, 1) & Format(vNumCK(rr, 2) * 100 + vNumCK(rr, i + 2), "0000") Next rr Set rngSorted = wsWk.Range("BB1:BB" & lastRw) For M = 3 To lastRw '優先順項目結合 strToSort(M, 1) = strToSort(M, 1) & Format(wsWk.Cells(M, "AY"), "0000") wsWk.Range("BB3:BB" & lastRw) = strToSort Next With wsWk.Sort .SortFields.Clear .SortFields.Add Key:=wsWk.Range("BB2"), SortOn:=xlSortOnValues, _ Order:=xlAscending, DataOption:=xlSortNormal .SetRange wsWk.Range("BB2:BB" & lastRw) .Header = xlYes .Apply End With Limit = IIf(kbn = "電" Or kbn = "話", 3, 1) cnt = 0 For k = 3 To lastRw If Left(rngSorted(k, 1), 1) <> "Z" Then cnt = cnt + 1 nativeRw = Val(Right(rngSorted(k, 1), 2)) vNumCK(nativeRw, 総) = vNumCK(nativeRw, 総) + 1 vNumCK(nativeRw, i + 2) = vNumCK(nativeRw, i + 2) + 1 vWK(nativeRw, CLNum) = vWK(nativeRw, CLNum) & kbn If Len(vWK(nativeRw, CLNum)) > 1 Then msgAlert = msgAlert & vbCrLf & "「" & vWK(nativeRw, 2) & "」さん" & _ vWK(nativeRw, CLNum) & "on " & Format(Dy, "m月d日") End If If cnt >= Limit Then Exit For End If End If Next k If k > lastRw Then msgAlert = msgAlert & vbCrLf & "「" & kbn & "」の対象者不在 on " & Format(Dy, "m月d日") End If Next i End If End If For i = 3 To lastRw '決定フラグ初期化 vNumCK(i, 済) = Empty Next '視認の為 ' wsWk.Range("A1").Resize(UBound(vWK), UBound(vWK, 2)) = vWK '割振り予定(文字表示) ' wsWk.Range("AI1").Resize(UBound(vNumCK), UBound(vNumCK, 2)) = vNumCK '集計 Next CLNum wsWk.Range("A1").Resize(UBound(vWK), UBound(vWK, 2)) = vWK '割振り予定(文字表示) wsWk.Range("AI1").Resize(UBound(vNumCK), UBound(vNumCK, 2)) = vNumCK '集計 ' シフト表を色付け & 当番表作成------------------------ For CLNum = target.Column To 33 For RWNum = 3 To lastRw If vWK(RWNum, CLNum) <> "" And WsShift.Cells(RWNum, CLNum) = "" Then Select Case True Case InStr(vWK(RWNum, CLNum), "ト"): WsShift.Cells(RWNum, CLNum).Interior.Color = 65585 Case InStr(vWK(RWNum, CLNum), "消"): WsShift.Cells(RWNum, CLNum).Interior.Color = 14083324 Case InStr(vWK(RWNum, CLNum), "会"): WsShift.Cells(RWNum, CLNum).Interior.Color = 14348258 Case InStr(vWK(RWNum, CLNum), "給"): WsShift.Cells(RWNum, CLNum).Interior.Color = 13408767 End Select If Not dicT.exists(vWK(2, CLNum)) Then Erase temp temp(1) = vWK(2, CLNum) dicT(vWK(2, CLNum)) = temp End If If InStr(vWK(RWNum, CLNum), "電") Then Tel = dicT(vWK(2, CLNum)) Tel(8) = Tel(8) + 1 Tel(1 + Tel(8)) = vWK(RWNum, 2) dicT(vWK(2, CLNum)) = Tel ElseIf InStr(vWK(RWNum, CLNum), "話") Then Tel = dicT(vWK(2, CLNum)) Tel(9) = Tel(9) + 1 Tel(4 + Tel(9)) = vWK(RWNum, 2) dicT(vWK(2, CLNum)) = Tel End If End If Next RWNum Next CLNum wsTel.UsedRange.Offset(1).Resize(, 7).ClearContents wsTel.Range("A2:G2").Resize(dicT.Count) = Application.Index(dicT.items, 0, 0) Application.ScreenUpdating = True dicT.RemoveAll If msgAlert <> "" Then MsgBox msgAlert Else MsgBox "完了" End If End Sub Private Sub inputFmlOnce(wsWk As Worksheet, RW As Long) wsWk.Range("AI1:AX1") = [{1,2,3,4,5,6,7,8,1,2,3,4,5,6,7,8}] Worksheets("除外リスト").Range("C2").FormulaLocal = "=シフト表!C2" '日付強制 wsWk.Range("AI2:AP2") = Array("済", "総", "ト", "電", "話", "消", "会", "給") wsWk.Range("AS2:BB2") = Array("ト", "電", "話", "消", "会", "給", "乱順&行", "乱数", "", "Sort") wsWk.Range("AS3").Resize(RW, 6).FormulaLocal = "=IF(COUNTIF(除外リスト!$A:$A,$B3)," & _ "IF(ISNUMBER(FIND(AS$2,VLOOKUP($B3,除外リスト!$A$1:$C$100,3,FALSE))),""Z"",""M""),""M"")" wsWk.Range("AS3").Resize(RW, 6) = wsWk.Range("AS3").Resize(RW, 6).Value wsWk.Range("AZ3").Resize(RW).FormulaLocal = "=RAND()" wsWk.Range("AZ3").Resize(RW) = wsWk.Range("AZ3").Resize(RW).Value wsWk.Range("AY3").Resize(RW).FormulaLocal = "=RANK(AZ3,AZ$3:AZ$" & RW + 2 & ")*100+ROW()" wsWk.Range("AY3").Resize(RW) = wsWk.Range("AY3").Resize(RW).Value End Sub Private Sub inputFmlUpdate(wsWk As Worksheet, RW As Long) Dim pos As Long pos = Application.Match(wsWk.Cells(2, wsWk.Range("BB1").Value), Worksheets("除外リスト").Range("A2:AG2"), 0) wsWk.Range("AS3").Resize(RW, 6).FormulaLocal = "=IF(COUNTIF(除外リスト!$A:$A,$B3)," & _ "IF(ISNUMBER(FIND(AS$2,VLOOKUP($B3,除外リスト!$A$1:$AG$100," & pos & ",FALSE))),""Z"",""M""),""M"")" wsWk.Range("AS3").Resize(RW, 6) = wsWk.Range("AS3").Resize(RW, 6).Value End Sub Sub resetToOriginal() Dim aCL As Range, App As Application Set App = Application With Worksheets("シフト表") On Error Resume Next Intersect(.UsedRange, .Range("A3:AG100")).SpecialCells(xlCellTypeFormulas, 23).ClearContents On Error GoTo 0 For Each aCL In Intersect(.UsedRange, .Range("A1:AG100")).Columns If IsNumeric(aCL.Cells(2, 1)) Then If App.NetworkDays(aCL.Cells(2, 1), aCL.Cells(2, 1), App.Range("祝日リスト")) = 1 Then aCL.Interior.Color = 16777215 End If End If Next aCL End With End Sub （半平太） 2023/10/23(月) 13:41:39 ---- 半平太さんえ、こんなに早く??? すごーーーーい!!ヾ（≧▽≦）職場でこっそりやってみました。でも、ちょっと質問です!!! 除外リストをご提案通りに実行したんですけど、あんまりわかってません。（頭弱いんです） <除外リスト>シート行 __A__ _____B_____ __________C__________ _____D_____ ___E___ 1 から1 から2 から3 2 社員備考 2023/10/1 2023/10/25 3 安藤骨折治療中トイレ、会議室、消毒 ←つまり安藤さんは10/24まで骨折、25日に完全復帰 4 江口風邪消毒消毒 ←江口さんは、とばっちりで再度「消毒」と書く必要があるこの除外リストは、月初からということは理解しました。だって、予定作ってるんだから、骨折や風邪ははじめからわかってますもんね。例えば、10日から介護で数日間在宅になります。・・・みたいな方はここに書かなくてもいいんですか? シフト表に「在」ってなってるから。江口さんがとばっちりで消毒と書く必要があるのは、25日まで安藤さんが骨折になっているからですか? たとえば、江口さんの風邪が7日で治ると仮定で予定くむとしたら、どうしたらいいですか? 安藤さんの骨折は25日まで当番ができないから、給湯当番を毎日あてるよー、電話当番もしなくていいよーってことは、これではできないということですか? から3はどんなときに使うんですか? ※2の説明ですが、もう一度アホでもわかるように教えていただけやしないでしょうか。(@_@;) ※3の「予定表」というのは何でしょうか。シフト表をわざわざ行とか削除しなくても、そのまま貼り付けてつかえるんですか? ※5は、午前・午後を区別したいときは、午前を「電」の一字、午後を「話」の一字で入力してください。これは、電話当番シートのことですか? それとも、指定できるということ? 作業用シートをちらっとみたら、「電」と「話」になっていて、午前と午後わかれていて感動していたんですけど、それとはまた別の話ですか?? それから、遅々とか早々とかは、本人がシフト表に入力するんですか? それから私のチープな案だとどんな不都合があったんですか?←ただ聞きたいだけチープな案とはいったんですけど、私にしては本当にいい案だと思ったんですよねぇ。私が、案に期間を書いたからかな。エクセルですべて社員リストを参考に配分してもらったあと、あとは情で、期間とかを自分で調整しなおしたらいいかなと思ったりしたんですよ。「いや、全員分書くの大変だろ」って思ってくれたんですか?(*‘ω‘ *) やさしーーー!! とにかく感動しております! お返事よろしくお願いします! （今月ゴミ当番） 2023/10/23(月) 15:21:42 ---- ＞例えば、10日から介護で数日間在宅になります。＞・・・みたいな方はここに書かなくてもいいんですか? その期間に完全に居ない人ですよね?それは書かないです。(休も同然なので）シフト表に「在」と書いて置けば、その期間だけはお偉いさんのハイフン「-」と同じことになります。＞江口さんがとばっちりで消毒と書く必要があるのは、＞25日まで安藤さんが骨折になっているからですか? 骨折で当番のが出来ないのは、10/24までで、10/25からは完全復帰なので、除外なし(空欄)です。プログラムとしては、10/25で全員見直しをするため、その日が空欄だと、江口さんの消毒も除外当番なしになるので、再登録が必要になると言う考えです。＞たとえば、江口さんの風邪が7日で治ると仮定で予定くむとしたら、＞どうしたらいいですか? 逆に安藤さんがとばっちりを受けるので、今迄と同じ除外当番名を入力する必要があります。 <除外リスト シート> 行 __A__ _____B_____ __________C__________ __________D__________ ____E____ 1 から1 から2 から3 2 社員備考 2023/10/1 2023/10/8 2023/10/25 3 安藤骨折治療中トイレ、会議室、消毒トイレ、会議室、消毒 4 江口風邪消毒＞安藤さんの骨折は25日まで当番ができないから、給湯当番を毎日あてるよー、＞電話当番もしなくていいよーってことは、＞これではできないということですか? 「トイレ、会議室、消毒」に「電話」を書き足すだけです。午前だけ当てないなら単に「電」。ただし、毎日当てるかはプログラムがどう処理するか次第です。他にロクに当番をやっていない人がいれば、そっちの人が当番になります。＞から3はどんなときに使うんですか? 「から3」と限定している訳じゃないです。除外予定が変更になる日付全てを書くものです。順不同ですが、常識的には、昇順でしょうね。＞※3の「予定表」というのは何でしょうか。＞シフト表をわざわざ行とか削除しなくても、そのまま貼り付けてつかえるんですか? ごめんなさい、シフト表のことです。そのまま使う構想です。(お偉いさんも載っているやつ）＞※5は、午前・午後を区別したいときは、午前を「電」の一字、午後を「話」の一字で入力してください。＞これは、電話当番シートのことですか? いや、除外リストシートの指定当番名のことです。その他にも作業シートなどにも出てくるので、知っている方がいいでしょうね。多分、出来栄えを判断するときに作業シートをしょっちゅう見ることになります。そこに当番担当回数が載っているので、出来の良し悪しが分かります。因みに、実行するたびに結果が変わるので、よさそうなのが出来上がるまで数回実行することになるでしょう。＞それから、遅々とか早々とかは、本人がシフト表に入力するんですか? はい、そのつもりですが、本人にその意思がないなら、管理者が修正するしかないです。＞それから私のチープな案だとどんな不都合があったんですか?←ただ聞きたいだけプログラムコードに落とすのが面倒と判断したので。無理にお使いいただく必要はありません。完全に作動する見通しもないですし、少し待っていれば、他の回答者が面白がってやってくれるかもです。（半平太） 2023/10/23(月) 16:39:58 ---- ＞シフト表に「在」と書いて置けば、＞その期間だけはお偉いさんのハイフン「-」と同じことになります。すみません。ならなかったです。 m(__)m 別途手当を考える必要があります。（半平太） 2023/10/23(月) 16:49:46 ---- ＞ Case "休", "早々", "遅々", "-" 「在」の追加が必要。 Case "休", "早々", "遅々", "-", "在" ただし、在宅で当番をやらなかった人は、職場復帰した途端に今迄全然当番をやらなかったね、ってことで、 (私のロジックでは）トイレ当番が集中的に割り振られてしまいます。どう考えればいいのか、私はノーアイデアです。没にしてくださいませ。（半平太） 2023/10/23(月) 17:18:13 ---- 半平太さん理解できました! ・・・といいたいところですが、 ※(4)除外リストの対象者がゼロても、2行目までは書き込んだ形で常駐させる必要があります。これはだれもいなかったとしても、 2行目までは誰の名前だけをいれておかなければいけないということですか? (私のロジックでは）トイレ当番が集中的に割り振られてしまいます。おー!そんな感情的なプログラムもできるんですね。トイレ当番が一番もめるんですよね。たくさんの素晴らしいアイデアをありがとうございます!! （今月ゴミ当番） 2023/10/24(火) 09:31:02 ---- 半平太さん質問です(*‘ω‘ *) ”総”とか”済”って何を意味してるんですか? （今月ゴミ当番） 2023/10/24(火) 11:03:34 ---- ＞※(4)除外リストの対象者がゼロても、2行目までは書き込んだ形で常駐させる必要があります。＞これはだれもいなかったとしても、＞2行目までは誰の名前だけをいれておかなければいけないということですか? 名前は3行目から入力なので、「除外リスト」シートが存在すればいいと言う意味と同じです。m(__)m 私が想定しなかったのは、管理者が、ある人にある当番種を直接シフト表に書き込んで決めてしまうこともあると言うことです。まぁ、これはやろうと思えば修正可能です。ただ、在宅勤務者が出社勤務になったとき、トイレ当番を連続して当ててしまうのは明らかにおかしいと言えますが、ではどうなればいいのかが不明で、これに対する考え方が確立されてないと修正はできないです。多分、他の回答者も知りたいんじゃないですかね。現実の当番回数が少ないのだから、トイレにはしないとしても、何らかの当番が優先的に当たるのは仕方ないのか、在宅が理由なら、当番回数の実績に水増しして上げるべきなのか在宅だろうが、休だろうが、出来ない事情があれば、同じ水増しをすべきなのか水増しといっても具体的にどんな日数にすべきなのか。正直いって、こう言う事態に対する考え方は部外者には分からないです。＞”総”とか”済”って何を意味してるんですか? 総は当番をやった回数合計です。済はあまり活用していません。・・と言うか現在ではほぼ無意味になった。当初は当日担当当番数に近いものを管理する予定だったんですが、想定外の要求が出てきたため、想定どおりの使い方が出来なくなってしまった。現状を正確に説明しようと思うと長くなるし、没の状態なので徒労でしかないです。（半平太） 2023/10/24(火) 14:22:57 ---- 半平太さん ※(4) 理解しました。('◇')ゞ私が想定しなかったのは、管理者が、ある人にある当番種を直接シフト表に書き込んで決めてしまうこともあると言うことです。 ↑これ。在宅の人のことですか?(´・ω・) でも、半平太さんが言われる通り、休と同じ考えですからね。平等っていうのは、トイレ当番は全員同じ回数やってほしいっていうのは、希望ではあるけれど、そこは仕方ないというか、例えば、25日間骨折してできなかった人は、復活したあと、ずっとトイレ掃除なんですよね。そんなことになったら気軽に休めなくなっちゃいますもんね。だから、そこは平等といってもトイレ掃除を同じ回数にするというより、当番の回数が均等にするとか、除外リストに載っている人は、均等に割り当てられる当番から外す、とか? 伝わりますかね。除外リストに載っていない人は、たとえばいろんな当番（電話当番以外）を月に5回ずつしていたとして、足を骨折していた人も25日間当番できなかった人は残りの5～6日間、みんなが5回ずつしてるから、5回しなければいけないというのではないということです。そこから後の回数は均等に・・・。 (@_@;)むずかしい・・・。（今月ゴミ当番） 2023/10/24(火) 15:55:22 ---- ＞↑これ。＞在宅の人のことですか?(´・ω・) いや出社の人で、何かの当番を恣意的にやらせたい日の、その人です。＞安藤さんの骨折は25日まで当番ができないから、給湯当番を毎日あてるよー、＞電話当番もしなくていいよーってことは、＞これではできないということですか? ↑ 例:この安藤さんシフト表に管理者が「給」と書けば、「給」が彼に確定するので、今まで通り連続にすることもできる。＞足を骨折していた人も25日間当番できなかった人は残りの5～6日間、＞みんなが5回ずつしてるから、5回しなければいけないというのではないということです。＞そこから後の回数は均等に・・・。復帰した日の前日に全員が当番を均等回数やっていればいいですけど、実際はあり得ない。その時点で、多めにやっていた人は、「誰々さんが復帰したので、いままでの実績はチャラ。今日からまた均等割振りします」と言われたら多分文句を言うでしょうね。全員の中で、一番少な目にやった人と同じとみなすんでしょうかねぇ・・（半平太） 2023/10/24(火) 16:58:26 ---- 半平太さんその時点で、多めにやっていた人は、「誰々さんが復帰したので、いままでの実績はチャラ。今日からまた均等割振りします」と言われたら多分文句を言うでしょうね。文句言う人はどんなことがあろうと文句いうんですよね。でも、「じゃぁ、自分で振り分けしたら?」って言いたくなる。(￣д￣)フン以前、骨折していた人が、申し訳なさそうに自分で気づいたことを当番だけじゃなくて日々の業務も一生懸命していたので、嫌味を言うようなおばちゃんたちよりも、何ならきちんとしてるので、その人が復帰出来たらトイレ掃除多めは、なんだか逆に気持ちとして不公平な気がします。(-"-) 当番は毎月均等に割り振られるものなので、在宅の人とか、風邪とか、けがをしてしまった人とか、そんなの、いつか自分もそうなったときに、お互い様だし!(￣д￣) 除外リストに、期間を設けないようにして、 1か月間できない人だけ除外リストに書くようにして、あとは均等にできるようにしたら、プログラムくみやすいですか? （今月ゴミ当番） 2023/10/24(火) 17:28:41 ---- ＞その人が復帰出来たらトイレ掃除多めは、なんだか逆に＞気持ちとして不公平な気がします。(-"-) トイレ多めの問題点は、再検討すべきものと(既に）認識しています。＞除外リストに、期間を設けないようにして、＞1か月間できない人だけ除外リストに書くようにして、＞あとは均等にできるようにしたら、＞プログラムくみやすいですか? その箇所はもう対処済みなので、再検討することは考えてないです。このアイデアについてはどうなんですか? ↓ ＞全員の中で、一番少な目にやった人と同じとみなすんでしょうかねぇ・・個人的には妥当と思っていますが、その回数は総回数のことなので、その水増しに見合った当番種内訳の水増しをどうするか、そのアイデアがまだ浮かばないですけど。（半平太） 2023/10/24(火) 19:08:24 ---- 半平太さん遅くなってすみませ～ん!!<(_ _)><(_ _)> 半平太さんが優秀すぎて・・。私の質問もアホすぎるのに、ちゃんと理解して回答してくださって、ありがとうございます!! 例:この安藤さんシフト表に管理者が「給」と書けば、「給」が彼に確定するので、今まで通り連続にすることもできる。そんなことができるんですか!!(@▽@;) 除外リストに電話も書き込めば電話当番まで変えてくれるし、午前か午後だけできないという除外までしてくれるプログラム!! 明日早速試してみます! 全員の中で、一番少な目にやった人と同じとみなすんでしょうかねぇ・・ ↑これ、見落としていました。すみません。とてもいいアイディアだと思います(*‘ω‘ *) 多分ですが、半平太さんのプログラムでは、初めに当番もシフト表に合わせて割り当て、電話当番も同時に割り当ててもらっているので、除外リストに「電話」と載っていない限り、均等に割り振られるようにしてくださっていますよね。そうすると、一番少ない人に合わせるとすると、骨折中の安藤さんは「給」とシフト表に書けば、割り当てられるということなので、問題はないとして、在宅者が問題ですね。在宅だとすべてできないので。みんなが文句いうのが嫌だということをいったから、平等に、水増しに見合うもの・・トイレ＞消毒＞・・・・考えてくれたんだと思うんですけど(´・ω・) トイレ掃除が一番いやな人が多いですけど、消毒が一番嫌いな人もいますし、給湯室が一番嫌な人もいて、全員の意見が合うわけではないので(-"-)←うまく聞き流す水増しという形は種類では決めず、なるべく一番少ない人に合わせるようにするだけで、半平太さんがいうように、作業シートを見て、一番いいものでOKにしたらいいですよね。思うようにいかない時は、自分で修正するとか。また的外れなこと言ってますか??('◇')ゞ（今月ゴミ当番） 2023/10/24(火) 23:57:25 ---- ＞明日早速試してみます! ちょっと待ってください。話がずれてます。＞例:この安藤さんシフト表に管理者が「給」と書けば、＞「給」が彼に確定するので、今まで通り連続にすることもできる。＞そんなことができるんですか!!(@▽@;) そう言う使い方をしたいと言うニーズを想定していなかったので、現バージョンは出来ません。それができる様に変更する事は出来る、と言った積りだったんですけど。＞トイレ掃除が一番いやな人が多いですけど、＞消毒が一番嫌いな人もいますし、給湯室が一番嫌な人もいて、＞全員の意見が合うわけではない個人別に好みが違うとなると話が広がり過ぎです。 ※私の仕事ならやるっきゃないですが、今回はそこまでは無理です。＞水増しという形は種類では決めず、ここは当面必要ないかも知れないです。(私も確信はないです）ただ、後で不徹底でマズかったなぁ・・と言う展開が待ってこともあり得る。悩ましい。（半平太） 2023/10/25(水) 08:17:21 ---- 半平太さんあらら。先走ったみたいですね。すみません。話が広がりすぎですなんで困らせちゃったんだ? と思って読み返したんですが。。はじめに私が平等に均等にと話したからなんだかややこしくしちゃってますね。(・_・;) 嫌な順番を聞かれた時、何に使うのかわからず、普通に私の意見として答えたんですが、水増しに見合うものを決める意味だったんですね。(ﾟ∀ﾟ) 平等って私が言うから! はじめから嫌なものランクで当番割りするつもりはなかったんです〜(_ _;) そんなこと思いつきもせず。語彙力がないばかりに〜(_ _;) ごめんなさーい! なので、水増しというのに見合う種類は決めずでお願いしたいです。文句おばさんたちをだまらせることはできます。掃除当番と電話当番が重なったときに文句発動するので、半平太さんのおかげで、それは今よりなくなりそうですからね! 重なった時は、エクセルが決めたのでって言えます! （今月ゴミ当番） 2023/10/25(水) 13:33:09 ---- 半平太さん水増しでなくすにはどこを修正したらいいですか? 使いたいなあと思ってるので、よろしくお願いします! （今月ゴミ当番） 2023/10/27(金) 12:45:34 ---- いま、水増しをする方向で考えています。総回数と電話回数は最低必要と考えますが、全部の当番種についてやるつもりです。ただ、総回数との整合性(当番種計=総回数）は無視します。具体的な増し回数は、当初、最少回数に合わせる、と言うアイデアでしたが、これは大変なことが分かりました。つまり、最低回数になった人にはその人なりの事情があるかも知れず、果たしてその最少回数を基準にしていいものか疑問だからです。これを真面目にやろうとするとロジックが大変なので、中央値(Median）がいいかなと。中央値なら、特殊な事情を持った人の回数じゃないので、ノーチェックで使えます(と思う）あと、誰を水増しするかですが、「在宅明け」は問題ないとして、連休明け(早々、遅々を含む）は何日間に設定すべきかも悩ましい。 1日では早すぎでしょうし、5日間なら保守的過ぎる。いま、3日連続でやろうと決心したところです。結構、面倒なので少し時間が掛かります。管理者が当番種を強制するニーズについては、解決の目途が立っています。ただし、1人につき、1日あたり1種限定(例:電話なら「電」か「話」のどちらか）（半平太） 2023/10/27(金) 13:18:13 ---- これでやってみてください。 Enum COL '使うシーンは、ほぼ無い済 = 1 総 = 2 ト電話消会給 End Enum Private Sub Worksheet_BeforeRightClick(ByVal target As Range, Cancel As Boolean) If target.Address(0, 0) = "C2" Then Cancel = True Call JobAssignment(target) End If End Sub Sub Main() Call JobAssignment(Worksheets("シフト表").Range("C2")) End Sub '[作業]シートと[除外リスト]シートを1枚挿入して置く Private Sub JobAssignment(target As Range) Dim wsShift As Worksheet, wsWK As Worksheet, wsTel As Worksheet Dim rWK As Range Dim vWK Dim vNumCK() Dim vNGCK() Dim vAdj() 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 Dim i As Long, k As Long, rr As Long, M As Long Dim Limit As Long, limitFixed(1 To 8) Dim POS Dim nativeRw As Long Dim strToSort() Dim Tel, temp(1 To 9) Dim dicT As Object Dim DataForTheDay As Range Dim previousDayCol(1 To 3, 1 To 33) As Long Dim medNum() Dim daysOff As Long Set Hldy = Application.Range("祝日リスト") Set wsShift = Worksheets("シフト表") Set wsWK = Worksheets("作業") Set wsTel = Worksheets("電話当番") Set dicT = CreateObject("Scripting.Dictionary") wsWK.UsedRange.Clear 'シフト表("A:AH")を作業シートに転記する Call resetToOriginal 'シフト表を初期状態に戻す Intersect(wsShift.UsedRange, wsShift.Range("A1:AG100")).Copy wsWK.Range("A1") With wsWK 'AG列までデータを格納 lastRw = wsWK.Cells(.Rows.Count, "B").End(xlUp).Row Set rWK = .Range("A1:A" & lastRw).Resize(, 33) vWK = rWK.Value End With 'チェック用数式の入力と監視用配列の確保 wsWK.Range("BB1") = target.Column inputFmlOnce wsWK, rWK.Rows.Count - 2 '3行目からが数式入力の為、マイナス2行とする vNumCK = rWK.Range("AI1:AP1").Resize(lastRw).Value vNGCK = rWK.Range("AQ1:AX1").Resize(lastRw).Value vAdj = rWK.Range("BD1:BK1").Resize(lastRw).Value '3営業前、2営業前,1営業前の列番号を配列に格納する With Application For i = 3 To 33 If wsWK.Cells(2, i) <> "" Then previousDayCol(1, i) = .Max(2, .WorkDay(wsWK.Cells(2, i), -1, Hldy) - rWK.Range("B1").Value2 + 3) previousDayCol(2, i) = .Max(2, .WorkDay(wsWK.Cells(2, i), -2, Hldy) - rWK.Range("B1").Value2 + 3) previousDayCol(3, i) = .Max(2, .WorkDay(wsWK.Cells(2, i), -3, Hldy) - rWK.Range("B1").Value2 + 3) End If Next i End With '割当本番-------------------------------- Application.ScreenUpdating = False For CLNum = target.Column To 33 Set DataForTheDay = rWK.Cells(1, CLNum).Resize(lastRw) '前日までの当番累計を書き出し wsWK.Range("AI1").Resize(UBound(vNumCK), UBound(vNumCK, 2)) = vNumCK '前日までの累を計書き出す '前日までの当番別累計の中央値を格納する ReDim medNum(1 To 8) For i = 2 To 8 '総→給 medNum(i) = Application.Median(wsWK.Range("AH3").Offset(0, i).Resize(lastRw - 2)) If IsError(medNum(i)) Then medNum(i) = 0 End If Next i '営業日チェック If vWK(2, CLNum) <> "" Then dy = vWK(2, CLNum) '2行目の曜日から日付を取得 If Application.NetworkDays(dy, dy, Hldy) = 1 Then '平日なら wsWK.Range("BB1") = CLNum '対象列を記入 '水増し処理 For k = 3 To lastRw Select Case vWK(k, CLNum) '当日の当番 Case "休", "早々", "遅々", "-", "在": 'doNothing Case Else '3連続前営業日が休かチェック If vWK(k, previousDayCol(1, CLNum)) = "在" Then Call doAdjust(k, vNumCK, medNum, vAdj) Else daysOff = 0 For M = 1 To 3 Select Case vWK(k, previousDayCol(M, CLNum)) Case "休", "早々", "遅々", "-": daysOff = daysOff + 1 End Select Next M If daysOff = 3 Then Call doAdjust(k, vNumCK, medNum, vAdj) End If End If End Select Next k If CLNum > 3 Then '除外リストのアップデート(必要ならば） If IsNumeric(Application.Match(rWK.Cells(2, rWK.Range("BB1").Value), _ Worksheets("除外リスト").Range("A2:AG2"), 0)) Then inputFmlUpdate wsWK, rWK.Rows.Count - 2 vNGCK = rWK.Range("AQ1:AX1").Resize(lastRw).Value End If End If '管理者指定当番があるかチェック Erase limitFixed '管理者指定当番:即確定 For rr = 3 To lastRw If vWK(rr, CLNum) <> "" Then POS = InStr("DDト電話消会給", Left(vWK(rr, CLNum), 1)) If POS > 2 Then vNumCK(rr, 総) = vNumCK(rr, 総) + 1 vNumCK(rr, POS) = vNumCK(rr, POS) + 1 limitFixed(POS) = limitFixed(POS) + 1 End If End If Next rr '視認の為 'wsWK.Cells(1, "AI").Resize(lastRw, 8) = vNumCK For i = 3 To 8 'ト-電-話-消-会-給 kbn = Mid("DDト電話消会給", i, 1) ReDim strToSort(3 To lastRw, 1 To 1) '優先順項目作成 For rr = 3 To lastRw strToSort(rr, 1) = IIf(Len(vWK(rr, CLNum)) >= 1, "Y", "A") Select Case kbn Case "電" If InStr(vWK(rr, CLNum), "遅") Then strToSort(rr, 1) = "Z" End If Case "話" If InStr(vWK(rr, CLNum), "早") Then strToSort(rr, 1) = "Z" ElseIf InStr(vNumCK(rr, i), "電") Then strToSort(rr, 1) = "Z" ElseIf InStr(vNumCK(rr, i), "消") Then strToSort(rr, 1) = "Z" End If End Select Select Case vWK(rr, rWK.Range("BB1").Value) Case "休", "早々", "遅々", "-", "在" strToSort(rr, 1) = "Z" Case "早", "遅" strToSort(rr, 1) = "X" End Select If vNGCK(rr, i) = "Z" Then strToSort(rr, 1) = "Z" End If strToSort(rr, 1) = strToSort(rr, 1) & Format(vNumCK(rr, 2) * 100 + vNumCK(rr, i), "0000") Next rr Set rngSorted = wsWK.Range("BB1:BB" & lastRw) For M = 3 To lastRw '優先順項目結合 strToSort(M, 1) = strToSort(M, 1) & Format(wsWK.Cells(M, "AY"), "0000") wsWK.Range("BB3:BB" & lastRw) = strToSort Next With wsWK.Sort .SortFields.Clear .SortFields.Add Key:=wsWK.Range("BB2"), SortOn:=xlSortOnValues, _ Order:=xlAscending, DataOption:=xlSortNormal .SetRange wsWK.Range("BB2:BB" & lastRw) .Header = xlYes .Apply End With Limit = IIf(kbn = "電" Or kbn = "話", 3, 1) '管理者が指定した当番を差し引く Limit = Limit - limitFixed(i) If Limit < 0 Then MsgBox "強制当番数が多すぎです " & CLNum - 2 & "日の「" & Mid("DDト電話消会給", i, 1) & "」" Exit Sub End If If Limit > 0 Then cnt = 0 For k = 3 To lastRw If Left(rngSorted(k, 1), 1) <> "Z" Then cnt = cnt + 1 nativeRw = Val(Right(rngSorted(k, 1), 2)) vNumCK(nativeRw, 総) = vNumCK(nativeRw, 総) + 1 vNumCK(nativeRw, i) = vNumCK(nativeRw, i) + 1 vWK(nativeRw, CLNum) = vWK(nativeRw, CLNum) & kbn If Len(vWK(nativeRw, CLNum)) > 1 Then msgAlert = msgAlert & vbCrLf & "「" & vWK(nativeRw, 2) & "」さん" & _ vWK(nativeRw, CLNum) & "on " & Format(dy, "m月d日") End If If cnt >= Limit Then Exit For End If End If Next k If k > lastRw Then msgAlert = msgAlert & vbCrLf & "「" & kbn & "」の対象者不在 on " & Format(dy, "m月d日") End If End If Next i End If End If For i = 3 To lastRw '決定フラグ初期化 vNumCK(i, 済) = Empty Next '視認の為 ' wsWK.Range("A1").Resize(UBound(vWK), UBound(vWK, 2)) = vWK '割振り予定(文字表示) ' wsWK.Range("AI1").Resize(UBound(vNumCK), UBound(vNumCK, 2)) = vNumCK '集計 Next CLNum wsWK.Range("A1").Resize(UBound(vWK), UBound(vWK, 2)) = vWK '割振り予定(文字表示) wsWK.Range("AI1").Resize(UBound(vNumCK), UBound(vNumCK, 2)) = vNumCK '集計 wsWK.Range("BD1").Resize(UBound(vAdj), UBound(vAdj, 2)) = vAdj '水増し回数 ' シフト表を色付け & 当番表作成------------------------ For CLNum = target.Column To 33 For RWNum = 3 To lastRw If vWK(RWNum, CLNum) <> "" And wsShift.Cells(RWNum, CLNum) = "" Then Select Case True Case InStr(vWK(RWNum, CLNum), "ト") wsShift.Cells(RWNum, CLNum).Interior.Color = 65585 wsShift.Cells(RWNum, CLNum).FormulaLocal = "=""ト""" Case InStr(vWK(RWNum, CLNum), "消"): wsShift.Cells(RWNum, CLNum).Interior.Color = 14083324 Case InStr(vWK(RWNum, CLNum), "会"): wsShift.Cells(RWNum, CLNum).Interior.Color = 14348258 Case InStr(vWK(RWNum, CLNum), "給"): wsShift.Cells(RWNum, CLNum).Interior.Color = 13408767 End Select End If If Not dicT.exists(vWK(2, CLNum)) Then Erase temp temp(1) = vWK(2, CLNum) dicT(vWK(2, CLNum)) = temp End If 'If CLNum = 29 Then Stop If InStr(vWK(RWNum, CLNum), "電") Then Tel = dicT(vWK(2, CLNum)) Tel(8) = Tel(8) + 1 Tel(1 + Tel(8)) = vWK(RWNum, 2) dicT(vWK(2, CLNum)) = Tel ElseIf InStr(vWK(RWNum, CLNum), "話") Then Tel = dicT(vWK(2, CLNum)) Tel(9) = Tel(9) + 1 Tel(4 + Tel(9)) = vWK(RWNum, 2) dicT(vWK(2, CLNum)) = Tel End If Next RWNum Next CLNum wsTel.UsedRange.Offset(1).Resize(, 7).ClearContents wsTel.Range("A2:G2").Resize(dicT.Count) = Application.Index(dicT.items, 0, 0) Application.ScreenUpdating = True dicT.RemoveAll If msgAlert <> "" Then MsgBox msgAlert Else MsgBox "完了" End If End Sub Private Sub inputFmlOnce(wsWK As Worksheet, RW As Long) wsWK.Range("AI1:AX1") = [{1,2,3,4,5,6,7,8,1,2,3,4,5,6,7,8}] wsWK.Range("BD1:BK1") = [{1,2,3,4,5,6,7,8}] Worksheets("除外リスト").Range("C2").FormulaLocal = "=シフト表!C2" '日付強制 wsWK.Range("AI2:AP2") = Array("済", "総", "ト", "電", "話", "消", "会", "給") wsWK.Range("AS2:BB2") = Array("ト", "電", "話", "消", "会", "給", "乱順&行", "乱数", "", "Sort") wsWK.Range("BD2:BK2") = Array("水増", "総", "ト", "電", "話", "消", "会", "給") wsWK.Range("AS3").Resize(RW, 6).FormulaLocal = "=IF(COUNTIF(除外リスト!$A:$A,$B3)," & _ "IF(ISNUMBER(FIND(AS$2,VLOOKUP($B3,除外リスト!$A$1:$C$100,3,FALSE))),""Z"",""M""),""M"")" wsWK.Range("AS3").Resize(RW, 6) = wsWK.Range("AS3").Resize(RW, 6).Value wsWK.Range("AZ3").Resize(RW).FormulaLocal = "=RAND()" wsWK.Range("AZ3").Resize(RW) = wsWK.Range("AZ3").Resize(RW).Value wsWK.Range("AY3").Resize(RW).FormulaLocal = "=RANK(AZ3,AZ$3:AZ$" & RW + 2 & ")*100+ROW()" wsWK.Range("AY3").Resize(RW) = wsWK.Range("AY3").Resize(RW).Value End Sub Private Sub inputFmlUpdate(wsWK As Worksheet, RW As Long) Dim POS As Long POS = Application.Match(wsWK.Cells(2, wsWK.Range("BB1").Value), Worksheets("除外リスト").Range("A2:AG2"), 0) wsWK.Range("AS3").Resize(RW, 6).FormulaLocal = "=IF(COUNTIF(除外リスト!$A:$A,$B3)," & _ "IF(ISNUMBER(FIND(AS$2,VLOOKUP($B3,除外リスト!$A$1:$AG$100," & POS & ",FALSE))),""Z"",""M""),""M"")" wsWK.Range("AS3").Resize(RW, 6) = wsWK.Range("AS3").Resize(RW, 6).Value End Sub Sub resetToOriginal() Dim aCL As Range, App As Application Set App = Application With Worksheets("シフト表") On Error Resume Next Intersect(.UsedRange, .Range("A3:AG100")).SpecialCells(xlCellTypeFormulas, 23).ClearContents On Error GoTo 0 For Each aCL In Intersect(.UsedRange, .Range("A1:AG100")).Columns If IsNumeric(aCL.Cells(2, 1)) Then If App.NetworkDays(aCL.Cells(2, 1), aCL.Cells(2, 1), App.Range("祝日リスト")) = 1 Then aCL.Interior.Color = 16777215 End If End If Next aCL End With End Sub '中央値に調整 Private Sub doAdjust(rr, vNum(), medNum, vAdj()) Dim cc As Long For cc = 2 To 8 vAdj(rr, cc) = vAdj(rr, cc) + medNum(cc) - vNum(rr, cc) vNum(rr, cc) = medNum(cc) Next cc End Sub （半平太） 2023/10/27(金) 18:35:24 ---- 半平太さんこんにちはー。(‘ω‘ ) 総回数と電話回数は最低必要と考えますが、全部の当番種についてやるつもりです。全部の当番で考えてくれてるんですね。つまり、最低回数になった人にはその人なりの事情があるかも知れず、果たしてその最少回数を基準にしていいものか疑問だからです。なるほど。ほんと、その通りですね。そこまで考えてなかった・・・・!<(_ _)> 誰を水増しするかですが、「在宅明け」は問題ないとして、連休明け(早々、遅々を含む）は何日間に設定すべきかも悩ましい。在宅は結局お仕事してますからね。おうちで。連休も、インフルエンザとか、お子さんの何かしらの事情がないとなかなかとらないので、 3日連続でなく、私は1日でもいいような気がしたんですけどね(´・ω・) 休みはペナルティじゃなくて、休憩なのに、連続当番が嫌で、連休とりたくなくなったりしないかなって不安です。私はまたよくわかんないこといってやしませんか(@_@;) 結構、面倒なので少し時間が掛かります。待ちまーす(*^▽^*) 「面倒なので」・・・ごめんなさい<(_ _)> 管理者が当番種を強制するニーズについては、解決の目途が立っています。ただし、1人につき、1日あたり1種限定(例:電話なら「電」か「話」のどちらか）今までいろんな方法を模索してくださってたんですね。やさしーーーーっ(ノ▽‘)・゜・。よろしくお願いしますっ!!('◇')ゞ（今月ゴミ当番） 2023/10/27(金) 18:38:29 ---- ↑ という文章を考えている間に、できてるじゃないですか!!!(ﾟДﾟ;) ありがとうございます。試してみますね♪ （今月ゴミ当番） 2023/10/27(金) 18:40:49 ---- 半平太さん遅くなりましたが、試してみました。(´・ω・) 1 2 6 7 8 9 10 13 14 15 16 17 20 21 22 24 27 28 29 30 氏名水木月火水木金月火水木金月火水金月火水木 1 安藤休休電電電会会会 2 伊藤休会会会 3 内村給給給給給 … … 16 清水給給休休休休休給給給給 17 鈴木会会会会休休休休休休 ↑こんな感じですが、他の方が連休をとっていると、休んでない方までとばっちりで連続当番になってしまいました(@_@;) 何度やり直しても、同じような状態になってしまうんです。散らしたいのですが、何か方法はないですか?(ﾟДﾟ;) よろしくお願いします!<(_ _)> （今月ゴミ当番） 2023/10/28(土) 00:49:12 ---- ＞休んでない方までとばっちりで連続当番になってしまいました(@_@;) へー、うまい具合に(マズい具合に?）にローテーションがハマっちゃったんですかね。毎日、サイコロを振ることにします。下記1行を追加した後、「Shuffle」をどこかにコピペしてください。＞ '割当本番-------------------------------- ＞ Application.ScreenUpdating = False ＞ For CLNum = target.Column To 33 shuffle wsWK, rWK.Rows.Count - 2 '←サイコロ振り直し 1行追加＞ Set DataForTheDay = rWK.Cells(1, CLNum).Resize(lastRw) '空きスペースに追加するプロシージャ ' ↓ Private Sub shuffle(wsWK As Worksheet, RW As Long) wsWK.Range("AZ3").Resize(RW).FormulaLocal = "=RAND()" wsWK.Range("AZ3").Resize(RW) = wsWK.Range("AZ3").Resize(RW).Value wsWK.Range("AY3").Resize(RW).FormulaLocal = "=RANK(AZ3,AZ$3:AZ$" & RW + 2 & ")*100+ROW()" wsWK.Range("AY3").Resize(RW) = wsWK.Range("AY3").Resize(RW).Value End Sub （半平太） 2023/10/28(土) 08:25:50 ---- 半平太さんはやっっ(ﾟДﾟ;) 早速ありがとうございます!!<(_ _)> 5回ほど試してみたんですけど、やっぱり同じものが連続に当番になってしまう～～(@_@;) これ、当番を社員の番号順みたいなのって難しいですか? 本当はランダムがいいんですけどね。「またこの人と電話当番かぶった。あいつ電話とらないんだよねー」とか、「月曜日ばっかり。月曜日は忙しいからいつもそういう日は嫌」とか、文句言われるから。でも連続になったら・・・・。((((;ﾟДﾟ))))ガクガクブルブルさいころ振ってるのに、どの当番も連続になるって、相当な確率ですよね・・・。(-"-) 私の運のなさかもしれないけれど、 4～5回とも連続になるという結果に・・・。冬近くになると連休をとる方がそこそこいるので、こうなってしまうのかも・・・。ランダムにするとこういうことが起きてしまうなら、順番にするしかないんですかね・・・。すみません・・・(´;ω;`)ウゥゥ（今月ゴミ当番） 2023/10/28(土) 09:58:36 ---- ＞5回ほど試してみたんですけど、＞やっぱり同じものが連続に当番になってしまう～～(@_@;) ちょっと信じがたいですねー 1.テストデータを共有したいので、後記のプログラムを実行して、結果をここにコピペしてください。 ※結果は、作業シートのA,B列に出てきます。結果例行 _A_ _______B_______ 1 3休 #3,3#3,12 2 遅 #3,4#3,13#9,13 3 消 #5,4#5,13#11,13 : : 2.因みに、禁止リストに誰か居ますか? Sub OutPutDATA() Dim wsShift As Worksheet, wsWK As Worksheet, wsTel As Worksheet Dim rWK As Range Dim vWK Dim dicT As Object Dim Hldy As Range Dim lastRw As Long Dim rr As Long, cc As Long Dim ky Set Hldy = Application.Range("祝日リスト") Set wsShift = Worksheets("シフト表") Set wsWK = Worksheets("作業") Set dicT = CreateObject("Scripting.Dictionary") wsWK.UsedRange.Clear 'シフト表("A:AH")を作業シートに転記する Call resetToOriginal 'シフト表を初期状態に戻す Intersect(wsShift.UsedRange, wsShift.Range("A1:AG100")).Copy wsWK.Range("A1") With wsWK 'AG列までデータを格納 lastRw = wsWK.Cells(.Rows.Count, "B").End(xlUp).Row vWK = .Range("A1:A" & lastRw).Resize(, 33).Value wsWK.UsedRange.Clear End With For cc = 3 To 33 For rr = 3 To lastRw If vWK(rr, cc) <> "" And vWK(rr, cc) <> "-" Then ky = vWK(rr, cc) ky = IIf(ky = "休", (rr Mod 5) & ky, ky) dicT(ky) = dicT(ky) & "#" & rr & "," & cc End If Next rr Next cc wsWK.Range("A1").Resize(dicT.Count, 2) = Application.Transpose(Array(dicT.keys, dicT.items)) wsWK.Cells(dicT.Count + 1, "A") = wsShift.Range("B1").Value End Sub （半平太） 2023/10/28(土) 10:15:02 ---- 「ここに」とは、「この掲示板のコメント欄に」の意味です。 (リンクが張ってある訳ではないです。以前勘違いした人が居たので、念の為）（半平太） 2023/10/28(土) 10:34:13 ---- 半平太さん 2休 #12,3#22,4#22,10#7,11#22,17#17,19#22,19#22,23#7,29#12,31#22,31 早 #5,4#3,9#17,12#5,17#12,18 遅 #18,4#12,8#5,32#16,32 3休 #13,8#13,9#23,9#8,10#13,10#3,11#13,11#3,12#13,12#13,15#13,16#23,26#8,32 4休 #4,11#14,11#9,12#14,12#14,15#14,16#14,17#19,26#9,32 0休 #5,18#15,19#15,22#15,23#20,23#15,24#5,26#15,26#15,29#5,31#10,31 1休 #16,19#21,19#21,24 2023/11/1 禁止リストは5人います（今月ゴミ当番） 2023/10/28(土) 11:11:49 ---- ＞禁止リストは5人います除外リストの状況が分からないと再現テストできないのですが。氏名を仮名にして、テスト用データを開示できないですか? (その仮名は、シフト表の何行目の人物であるかも知りたいのですが。) （半平太） 2023/10/28(土) 11:41:19 ---- この回答者懲りずによくやっているよ。質問者もくだらないことをグタグタ言ってきていつ終わらせるの。（ちゃばん） 2023/10/28(土) 12:15:51 ---- くだらないかどうか未だ分からないです。つーか、不愉快ならスルーが一番ですよ。（半平太） 2023/10/28(土) 12:46:29 ---- 半平太さん除外リストには、お偉いさんが4人と、当番ができない人を一人、いれています。<(_ _)> すべて、掃除当番も電話当番も1か月間除外するという形でいれています。お偉いさんは18～21行目当番ができない人は、5行目です。<(_ _)> ちゃばんさん相当暇なんかしらんけど、わざわざ文句書かないでくれる? そんなにくだらないくらい簡単な事なら、教えてください。私はともかく、手を差し伸べてくれてる人をバカにしたような言い回しすんな(-_-メ) （今月ゴミ当番） 2023/10/28(土) 18:19:20 ---- 1.再現しました。総回数の多寡を最優先に決定するのはマズいと判断せざるを得ません。 2.すると、その時々に決める当番種の多寡を最優先とする(次が総回数、次がサイコロ）と言うロジックの方が、当番種にバリエーションが出る様な気がしてきました。。ご提示のサンプルデータでテストしてみた限りでは、そう言えそうです。と言うことで、以下の一行の演算記号の位置を取替えてみてください。 '＞strToSort(rr, 1) = strToSort(rr, 1) & Format(vNumCK(rr, 2) * 100 + vNumCK(rr, i), "0000") ↓ ↓ strToSort(rr, 1) = strToSort(rr, 1) & Format(vNumCK(rr, 2) + 100 * vNumCK(rr, i), "0000") （半平太） 2023/10/28(土) 20:13:17 ---- 半平太さん shuffle wsWK, rWK.Rows.Count - 2 は追加のまま、取り替えでいいですか?(*^▽^*) （今月ゴミ当番） 2023/10/28(土) 21:46:05 ---- いいです。 3人でローテーションを組む場合 (1)ABC ABC の順とするか、2巡目でサイコロを廻して、 (2)ABC BAC 等の順を望むかの違いです。 (1)の時、Bの人は、いつもAの後と決まっていて困ると文句を言えるし、 (2)の時、Bの人は、Aより先に番が廻って来たのは不当だと文句が言える。 Shuffleを入れると言うことは、(2)の系列に入るもの。（半平太） 2023/10/28(土) 22:54:59 ---- 半平太さんできました!!(#^▽^#) さっきのように複数の人が3日連続になるようなことがなくなりました!! Shuffleを入れた場合の説明も、よくわかりました!! 文句の言葉の例も、言われそう～。（笑）( *´艸｀) 2度手間だし、文句言われながらも、仕方なくやっていた作業を、 1度でできるようにしてくださって・・・優しくて、丁寧で感動しましたヾ(≧▽≦)ノ本当に長い間、助けてくださってありがとうございました!<(_ _)><(_ _)><(_ _)><(_ _)> 大切に使っていきます☆彡（今月ゴミ当番） 2023/10/28(土) 23:24:57 ---- 勉強中です。シフト表の一番上にタイトルをつけると知識不足のため、あちこちでエラーが起きました。解釈が間違っているところが多々あるのだろうと思うのですが、たった1行の改行で何が間違っているのかわかりません。（ハム） 2023/11/16(木) 00:15:13 ---- こう言うQ&A掲示板の回答は、レイアウトは決打ちで作りますからねぇ・・レイアウト変更に起因するコードの見直し作業は、正直、気が進まないです。面白味がほとんどないので。各職場の事情は様々なので、そのまま使えるケースは殆どないと思います。実際に必要なのであれば、個別事情を明らかにして新規に質問を立ててください。ここの回答案も改良の余地がある代物です。（半平太） 2023/11/16(木) 09:42:33 ...; https://www.excel.studio-kazu.jp/wiki/kazuwiki/202310/20231020232949.txt - [detail] - similar

PREV NEXT

訪問者：カウンタ