[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『休みを考慮して平等な当番表を作りたいです』（くみっきー）
初めまして！
困っているのでお願いします(◞‸◟)
●横行A1:A1に日付
●縦列A1：A6にスタッフ名（現在6人いてます）
●掃除の当番が一日に5種類あります（ABCDE）
シフトの休みを考慮して掃除の当番が平等になるように入れ込みたいのですが、
何かいい方法はありますでしょうか？
休みは皆バラバラで、最低で4人出勤の日もあります
お手数おかけしますが宜しくお願い致します。
＜ 使用 Excel：Excel2010、使用 OS：Windows10 ＞
1週間分でいいので、具体例を提示して貰えませんか？
※無理にとは言いませんが、私はイメージが涌かなくて・・
（半平太） 2019/07/27(土) 18:37
8/1 8/2 8/3 8/4 8/4 8/5 8/6 8/7 合計
りんご 休み A B C 休 D 休 CE
みかん B C D FE 休 A E 休
いちご A D CF B E F A 休
すいか C BE A 休 D B F DE
めろん D F E AD C E B 休
れもん F 休 休 休 AB C D AB
（くみっきー） 2019/07/27(土) 19:02
イメージは分かりました。
１．土日祝は無関係な表ですね？
２．実際の表の右端は、８月末迄ですか？
３．"●掃除の当番が一日に5種類あります（ABCDE） " ・・との事ですが、 Fも出ているので、 ↓ "●掃除の当番が一日に6種類あります（ABCDEF）"の間違いですか？
４．8/7にEが2回出てますが、どちらかがFの間違いですか？
５．「休」は、どこかに各員の休み予定表があって、
今後はそれも自動的に表示したい、ということですか？
YESの場合、どんな「休み予定表」になっているのか、
上の表と同じ様なサンプルを提示してください。
（半平太） 2019/07/27(土) 20:09
8/1 8/2 8/3 8/4 8/4 8/5 8/6 8/7 合計
りんご 休み A B C 休 D 休 C
みかん B C D E 休 A E 休
いちご A D C B E 休 A 休
すいか C B E 休 D B C DE
めろん D E A AD C E B 休
れもん E 休 休 休 AB C D AB
（くみっきー） 2019/07/27(土) 22:24
ちょっと厄介なのでマクロにしますよ。
＞休みはスタッフが毎月休み希望をだしてそのまま休みになるので毎月日数も曜日もバラバラです。 ＞なので下記の表にまず休みを入力して、空いているセルに当番を割り振っています。
全員が出社の場合、1人余りますので、その人は強制的に休みにすることにします。 ※手入力した休みと区別するため、(休）と言う文字で出します。
また、やり直し操作を容易にするため、「割り当てた当番名」や「(休)」は、数式の形で出力します。 例1: ="(休み)" 例2: ="A"
※そうやっておくと、マクロ「ClearResult」を実行すれば、 数式だけ消えるので、簡単に「手入力の休み」だけの状態に戻れます。
<当番表> 実行前 各社員の休みの希望日を入力しただけの状態 行 ___A___ __B__ __C__ __D__ __E__ __F__ __G__ _H_ _I_ _J_ _K_ _AD_ _AE_ _AF_ _AG_ _AH_ 1 8/26 8/27 8/28 8/29 8/30 8/31 9/1 9/2 9/3 9/4 9/23 9/24 9/25 合計 2 りんご 休 休 休 0 3 みかん 休 休 0 4 いちご 休 休 0 5 すいか 休 0 6 めろん 休 0 7 れもん 休 休 休 0
<当番表> マクロ「JobAssign」を実行後 行 ___A___ __B__ __C__ __D__ __E__ __F__ __G__ _H_ _I_ __J__ __K__ _AD_ _AE_ _AF_ _AG_ _AH_ _AI_ _AJ_ _AK_ _AL_ _AM_ __AN__ __AO__ _AP_ __AQ__ 1 8/26 8/27 8/28 8/29 8/30 8/31 9/1 9/2 9/3 9/4 9/23 9/24 9/25 合計 A B C D E 予備1 予備2 調整 調整後 2 りんご 休 A B CB 休 D 休 EC D E A (休) A 26 6 5 5 5 5 26 3 みかん A B C D 休 E A 休 B C (休) A B 26 5 5 5 6 5 26 4 いちご B C A E D 休 B 休 A D B C C 26 5 5 6 5 5 26 5 すいか C D E 休 B A D A C B C D D 26 5 5 5 6 5 26 6 めろん D E D A C C E 休 E (休) D E E 26 5 5 5 5 6 26 7 れもん E 休 休 休 AE B C DB (休) A E B (休) 25 5 6 5 4 5 25
※上の行から割り当てて行きますので、上の人が不利になることがあるので、 次の月に実行する場合は、不利になった人の調整欄(AP列）に1を入れてください。
(上の例だと、レモンさん以外の人は、今月余分に1回やっているので、 9月は、調整欄に1を埋め、1回余分にやったように装ってから実行してください。 するとレモンさんがだけゼロスタートなので、割当はレモンさんから始まります。)
<当番表> 翌月になり調整欄に1を補ってから実行した場合の例
行 ___A___ __B__ __C__ __D__ __E__ __F__ __G__ __H__ __I__ __J__ __K__ __AD__ __AE__ _AF_ _AG_ _AH_ _AI_ _AJ_ _AK_ _AL_ _AM_ __AN__ __AO__ _AP_ __AQ__ 1 9/26 9/27 9/28 9/29 9/30 10/1 10/2 10/3 10/4 10/5 10/24 10/25 合計 A B C D E 予備1 予備2 調整 調整後 2 りんご 休 A B CE 休 D 休 BE C E (休) A 25 5 4 6 5 5 1 26 3 みかん B C A D 休 E A 休 B C B C 25 5 5 5 5 5 1 26 4 いちご C B D A E 休 B 休 A D C D 25 5 5 5 5 5 1 26 5 すいか D E C 休 A B C D E (休) E B 25 5 6 4 5 5 1 26 6 めろん E D E B C A D 休 (休) A D E 25 5 5 5 5 5 1 26 7 れもん A 休 休 休 BD C E AC D B A (休) 25 5 5 5 5 5 25
標準モジュールへ貼り付け
Type staff
Name As Variant
ScheD As Range
CurrV() As Variant
CurrA As Range '今月担当した当番の種類と数
AccmT As Range
End Type
Sub JobAssign()
Const numOfJobs As Long = 5 'ABCDE
Const numOfStaffs As Long = 6 '人数
Dim ws当番 As Worksheet
Dim 社員(1 To numOfStaffs) As staff
Dim 連番Ary()
Dim 当日割当管理板() As Boolean '当日割当てた当番を管理
Dim 当番名Ary
Dim idx As Long
Dim JobIdx As Long '当番名のIndex
Dim DateCol As Long
Dim Fewest As Long '最優先キー
Dim sortKey As Long '当日回数<累計割当＜idx
Dim unAssigned As Long '未割当数
連番Ary = Evaluate("row(A1:A" & numOfJobs & ")")
Set ws当番 = Sheets("当番表")
Application.ScreenUpdating = False
Rem 基本データを格納
With ws当番
当番名Ary = .Range("AI1:AP1").Value '当番名配列
For idx = 1 To numOfStaffs
社員(idx).Name = .Cells(idx + 1, "A").Value
Set 社員(idx).ScheD = .Cells(idx + 1, "B").Resize(1, 31)
Set 社員(idx).CurrA = .Cells(idx + 1, "AI").Resize(1, numOfJobs)
Set 社員(idx).AccmT = .Cells(idx + 1, "AQ")
Next idx
'表の集計エリアのタイトルを書き込む
.Range("AH1").Resize(1, 10).Value = [{"合計","A","B","C","D","E","予備1","予備2","調整","調整後"}]
'集計用の数式を埋め込む
.Range("AH2:AO10").ClearContents
.Range("AH2").Resize(numOfStaffs, 1).FormulaR1C1Local = "=SUM(RC[1]:RC[7])"
.Range("AQ2").Resize(numOfStaffs, 1).FormulaR1C1Local = "=SUM(RC[-9],RC[-1])"
.Range("AI2").Resize(numOfStaffs, 7).FormulaR1C1Local = _
"=IF(RC1="""","""",IF(LEFT(R1C,2)=""予備"","""",COUNTIF(RC2:RC33,""*""&R1C&""*"")))"
End With
Rem 割当開始
For DateCol = 1 To 31 '31迄 日付順に決定する
ReDim 当日割当管理板(1 To numOfJobs)
'当日、全社員が休みでないか、または日付データが正しいか、事前確認
If Application.CountIf(ws当番.Cells(2, DateCol + 1).Resize(numOfStaffs), "*休*") < numOfStaffs _
And IsDate(ws当番.Cells(1, DateCol + 1)) Then
'各社員が当日に割当てられた当番の記憶をクリア
For idx = 1 To numOfStaffs
ReDim 社員(idx).CurrV(0 To numOfJobs)
Next idx
'最少当番割当者を決定する. 順位；当日割当数＜累計割当数
unAssigned = numOfJobs '未割当数を初期化
Do While unAssigned > 0
Fewest = 99999999 '仮置き
For idx = 1 To numOfStaffs
With 社員(idx)
If .ScheD(1, DateCol).Value = "" Or .ScheD(1, DateCol).HasFormula Then
sortKey = .CurrV(0) * 100000 + .AccmT(1, 1) * 100 + idx
Fewest = Application.Min(sortKey, Fewest)
End If
End With
Next idx
idx = Fewest Mod 100 '割当てるべきスタッフのIndexをセット
JobIdx = getJob(社員(idx), 連番Ary, 当日割当管理板) '割り当てる当番名Indexを取得する
'割り当てる当番名を数式の形で出力する
社員(idx).ScheD(1, DateCol).Formula = "=""" & 社員(idx).ScheD(1, DateCol) & 当番名Ary(1, JobIdx) & """"
'決定後の処理
社員(idx).CurrV(0) = 社員(idx).CurrV(0) + 1 '当社員の当日担当数をインクリメント
当日割当管理板(JobIdx) = True '決定フラグで埋めて、割当状況を更新
unAssigned = unAssigned - 1 '未割当て残数をディクリメント
Loop
End If
'当日余った人は、強制的に休みにする（表示文字は「(休)」として、手入力の休みとは区別する。
If IsDate(ws当番.Cells(1, DateCol + 1)) Then
On Error Resume Next
ws当番.Cells(2, DateCol + 1).Resize(numOfStaffs).SpecialCells(xlCellTypeBlanks).Value = "=""(休)"""
On Error GoTo 0
End If
Next DateCol
Application.ScreenUpdating = True
End Sub
Private Function getJob(ByRef targetStaff As staff, ByRef 連番Ary, ByRef 当日割当管理板)
Dim JobsInOrder, NN As Long
'担当過少当番順
ReDim JobsAssignedSofar(1 To UBound(連番Ary))
For NN = 1 To UBound(連番Ary)
JobsAssignedSofar(NN) = targetStaff.CurrA(1, NN) * 100 + NN
Next NN
JobsInOrder = Application.Small(JobsAssignedSofar, 連番Ary)
For NN = 1 To UBound(連番Ary)
getJob = JobsInOrder(NN, 1) Mod 100
If 当日割当管理板(getJob) = False Then
Exit Function
End If
Next
If NN > UBound(連番Ary) Then Stop 'あり得ない
End Function
'手入力の休み以外を空白に戻す ← 振り出しの戻したい時に実行するプログラム
Sub ClearResult()
On Error Resume Next
Range("B2:AF10").SpecialCells(xlCellTypeFormulas, 23).Clear
On Error GoTo 0
Range("B2").Select
End Sub
（半平太） 2019/07/28(日) 14:57
と出てきてしまいました。
貼り付け方が間違っているのでしょうか(◞‸◟)
初心者すぎてわからなくてすみません(◞‸◟)
お手数おかけしますが宜しくお願いします。
（くみっきー） 2019/07/28(日) 16:24
>標準モジュールへ貼り付け
とありますが。 （OK） 2019/07/28(日) 16:32
参考になると思います。
マクロってどこに書けばいいの？ http://officetanaka.net/excel/vba/beginner/10.htm （OK） 2019/07/28(日) 16:34
できました！！
シート名を「当番表」に変えたら実行されました！
感動です!(^^)!
会社に半平太さんみたいな人が居たらいいのに(◞‸◟)
とにかく凄く嬉しいです！
ありがとうございました！
（くみっきー） 2019/07/28(日) 16:43
ありがとうございます！
添付して頂いたサイトで勉強させて頂きます！
（くみっきー） 2019/07/28(日) 19:46
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.