プロが教えるわが家の防犯対策術!

私どもはある組織の宿日直を総員7名でやっております、宿直も日直も2名で出勤します。
人員の配置は毎月籤を引きながらやっておりますがどうしても毎月同じ人同士の組み合わせになることが多くあります、そこで何とかEXCELLを使い皆でランダムにやる方法はないかと考えております、私も考えてみたのですがなかなかよい方法(工夫)が出来ません何方かお知恵を拝借したいと思い質問を致します。

平日(P.M.5:30~次の日のA.M.8:30まで)の宿直と土・日・祝祭日の日直を(A.M.8:30~P.M.5:30)7名で行っております(年間365日休めません)、人員の配置方法としての禁止事項は以下の通りです。
1)宿直の次に日直は出来ません(連続での出勤になりますので)。
2)宿直が連続で出来ません(出来ないことはありませんが出来ればしない方がgood!)。
3)7名の人員を宿直と日直は常にランダムで行いたい、つまり毎回出来れば同じ組み合わせ  でやりたくない。
4)年間で考えたいと思います。(月毎ですと月末と月初の組み合わせが上記の禁止事項になることがある)
以上の条件でEXCELLに拘りませんので方法がないものかと考えております、宜しくお願い致します。(人員はA・B・・・・F・Gで表現します)

A 回答 (10件)

↓から続きです。



'★ここから後半
If Cells(i, "D") = "" Then
Do Until myFlg = True
If myRow = endRow Then
myRow = 1
End If
myRow = myRow + 1
str1 = Left(Cells(myRow, "I"), InStr(Cells(myRow, "I"), ",") - 1)
str2 = Mid(Cells(myRow, "I"), InStr(Cells(myRow, "I"), ",") + 1, 10)
Set c = myRng1.Find(what:=str1, LookIn:=xlValues, lookat:=xlPart)
Set r = myRng1.Find(what:=str2, LookIn:=xlValues, lookat:=xlPart)
If c Is Nothing And r Is Nothing Then
myFlg = True
Else
Cells(Rows.Count, "P").End(xlUp).Offset(1) = Cells(myRow, "I")
End If
Loop
Cells(i, "D") = Cells(myRow, "I")
myFlg = False
End If

If WorksheetFunction.CountA(Range("P:P")) > 0 Then
For k = 2 To Cells(Rows.Count, "P").End(xlUp).Row
If Cells(k, "P") <> "" Then
str1 = Left(Cells(k, "P"), InStr(Cells(k, "P"), ",") - 1)
str2 = Mid(Cells(k, "P"), InStr(Cells(k, "P"), ",") + 1, 10)
Set c = myRng2.Find(what:=str1, LookIn:=xlValues, lookat:=xlPart)
Set r = myRng2.Find(what:=str2, LookIn:=xlValues, lookat:=xlPart)
If c Is Nothing And r Is Nothing Then
myFlg = True
Exit For
End If
End If
Next k
If myFlg = True Then
Cells(i, "E") = Cells(k, "P")
Cells(k, "P").ClearContents
myFlg = False
End If
End If

If Cells(i, "E") = "" Then
Do Until myFlg = True
If myRow = endRow Then
myRow = 1
End If
myRow = myRow + 1
str1 = Left(Cells(myRow, "I"), InStr(Cells(myRow, "I"), ",") - 1)
str2 = Mid(Cells(myRow, "I"), InStr(Cells(myRow, "I"), ",") + 1, 10)
Set c = myRng2.Find(what:=str1, LookIn:=xlValues, lookat:=xlPart)
Set r = myRng2.Find(what:=str2, LookIn:=xlValues, lookat:=xlPart)
If c Is Nothing And r Is Nothing Then
myFlg = True
Else
Cells(Rows.Count, "P").End(xlUp).Offset(1) = Cells(myRow, "I")
End If
Loop
Cells(i, "E") = Cells(myRow, "I")
myFlg = False
End If
Next i
Range("P:P").ClearContents
End Sub

※ とりあえずA~Gのメンバーの年間日数はある程度バランスが取れると思います。m(_ _)m
    • good
    • 0

No.3・5です。



もう一度考えてみました。
前回のコードは消去して↓のコードにしてみてください。
(今回もシートモジュールです)
尚、P列も予備の組合せ(続けて勤務できない組合せ)用として使用していますので、
P列は使っていない状態にしてください。
今回も必要なのは前回の画像通りの配置にしておいてください。

必要なのはA~C列とG列のデータのみです。

尚、一度に投稿すると制限文字数を超えそうなので
2回に分けて投稿します。

まず前半部分です

Sub 振り分け3()
Dim i As Long, k As Long, cnt As Long, myRow As Long, lastRow As Long, endRow As Long
Dim myRng1 As Range, myRng2 As Range, myFlg As Boolean
Dim str1 As String, str2 As String, c As Range, r As Range

'▼組合せ順
endRow = Cells(Rows.Count, "I").End(xlUp).Row
If endRow > 1 Then
Range(Cells(2, "I"), Cells(endRow, "J")).ClearContents
End If
cnt = 1
For i = 2 To Cells(Rows.Count, "G").End(xlUp).Row
For k = i + 1 To Cells(Rows.Count, "G").End(xlUp).Row
cnt = cnt + 1
Cells(cnt, "I") = Cells(i, "G") & "," & Cells(k, "G")
Next k
Next i
endRow = Cells(Rows.Count, "I").End(xlUp).Row
With Range(Cells(2, "J"), Cells(endRow, "J"))
.Formula = "=RAND()"
.Value = .Value
End With
Range(Cells(1, "I"), Cells(endRow, "J")).Sort key1:=Range("J1"), order1:=xlAscending, Header:=xlYes
'▲

'▼D・E列表示
lastRow = Cells(Rows.Count, "A").End(xlUp).Row
If lastRow > 1 Then
Range(Cells(2, "D"), Cells(lastRow, "E")).ClearContents
End If
Range(Cells(2, "L"), Cells(lastRow, "M")).Formula = "=LEFT(D2,1)"
Range(Cells(2, "N"), Cells(lastRow, "O")).Formula = "=RIGHT(D2,1)"
Range(Cells(2, "H"), Cells(Cells(Rows.Count, "G").End(xlUp).Row, "H")).Formula = "=COUNTIF(L:O,G2)"

myRow = 1
For i = 2 To Cells(Rows.Count, "A").End(xlUp).Row
Set myRng1 = Cells(i - 1, "E")
Set myRng2 = Union(Cells(i - 1, "E"), Cells(i, "D"))

If WorksheetFunction.CountA(Range("P:P")) > 0 Then
For k = 2 To Cells(Rows.Count, "P").End(xlUp).Row
If Cells(k, "P") <> "" Then
str1 = Left(Cells(k, "P"), InStr(Cells(k, "P"), ",") - 1)
str2 = Mid(Cells(k, "P"), InStr(Cells(k, "P"), ",") + 1, 10)
Set c = myRng1.Find(what:=str1, LookIn:=xlValues, lookat:=xlPart)
Set r = myRng1.Find(what:=str2, LookIn:=xlValues, lookat:=xlPart)
If c Is Nothing And r Is Nothing Then
myFlg = True
Exit For
End If
End If
Next k
If myFlg = True Then
Cells(i, "D") = Cells(k, "P")
Cells(k, "P").ClearContents
myFlg = False
End If
End If
'★ここまでが前半
    • good
    • 0

リンクが違っていたようなのでもう一度



https://drive.google.com/file/d/0Byv1RH48tHeaWDV …

何度もすみません
    • good
    • 0

マクロが正常動作しなかったので、修正版をUPしました



https://drive.google.com/file/d/0Byv1RH48tHeaSUN …

ダウンロードして試して下さい
    • good
    • 0

No4です



不可能だけで終わるのも何なので、一応手動で制作するシートを作ってみました

https://drive.google.com/file/d/0Byv1RH48tHeaV0U …

メインシートで選択可能なパターン一覧から【選択】をクリックして【決定】ボタンをクリックしていくだけで勤務表が追加されていきます
【取消】で一日分削除されます

パターン一覧でセルの塗りつぶし数が多いものを選択していくだけで、勤務日数/休日が平均的に割りつけされます


条件として
過去30日に同じパターンがない
過去一週間で同じペアでの日直がない
過去一週間で同じペアでの宿直がない
日直→日直の勤務がない
宿直→宿直の勤務がない
連休がない

※計算Sheetは作業用のシートなので編集しないで下さい(一応PW無しで保護してあります)

勤務表作成の参考にして下さい
    • good
    • 0

No.3です。



もう一度考えてみました。
結論としてバランスよく!は難しいと思います。

(1)~(3)重視で考えてみました。
極力同じメンバー同士の組み合わせにならないようにしてみましたが
そうすると年間出勤日数のばらつきが出てきます。

↓の画像のようにA~C列は前回同様の様式にしておいてください。
今回はD・E列に表示させてみました。

画像では色々表示されていますが、必要なのはA~C列と「メンバー表」のG列だけです。

I列はG列メンバーのすべての組合せを重複なしに表示させています。
J列はI列をランダムに並び替えるための列です。
L~O列は各行(その日)の出勤メンバーです。
H列はG列の人が年間何日の出勤か?を計算しています。
(これらはマクロで処理しています)

前回同様シートモジュールにしてみてください。

Sub 振り分け2()
Dim i As Long, k As Long, cnt As Long, myRow As Long, lastRow As Long, endRow As Long
Dim myRng1 As Range, myRng2 As Range, myFlg As Boolean
Dim str1 As String, str2 As String, c As Range, r As Range

'▼組合せ順
endRow = Cells(Rows.Count, "I").End(xlUp).Row
If endRow > 1 Then
Range(Cells(2, "I"), Cells(endRow, "J")).ClearContents
End If
cnt = 1
For i = 2 To Cells(Rows.Count, "G").End(xlUp).Row
For k = i + 1 To Cells(Rows.Count, "G").End(xlUp).Row
cnt = cnt + 1
Cells(cnt, "I") = Cells(i, "G") & "," & Cells(k, "G")
Next k
Next i
endRow = Cells(Rows.Count, "I").End(xlUp).Row
With Range(Cells(2, "J"), Cells(endRow, "J"))
.Formula = "=RAND()"
.Value = .Value
End With
Range(Cells(1, "I"), Cells(endRow, "J")).Sort key1:=Range("J1"), order1:=xlAscending, Header:=xlYes
'▲

'▼D・E列表示
lastRow = Cells(Rows.Count, "A").End(xlUp).Row
If lastRow > 1 Then
Range(Cells(2, "D"), Cells(lastRow, "E")).ClearContents
End If
Range(Cells(2, "L"), Cells(lastRow, "M")).Formula = "=LEFT(D2,1)"
Range(Cells(2, "N"), Cells(lastRow, "O")).Formula = "=RIGHT(D2,1)"
Range(Cells(2, "H"), Cells(Cells(Rows.Count, "G").End(xlUp).Row, "H")).Formula = "=COUNTIF(L:O,G2)"
myRow = 1
For i = 2 To Cells(Rows.Count, "A").End(xlUp).Row
Set myRng1 = Cells(i - 1, "E")
Set myRng2 = Union(Cells(i - 1, "E"), Cells(i, "D"))

Do Until myFlg = True
If myRow = endRow Then
myRow = 1
End If
myRow = myRow + 1
str1 = Left(Cells(myRow, "I"), InStr(Cells(myRow, "I"), ",") - 1)
str2 = Mid(Cells(myRow, "I"), InStr(Cells(myRow, "I"), ",") + 1, 10)
Set c = myRng1.Find(what:=str1, LookIn:=xlValues, lookat:=xlPart)
Set r = myRng1.Find(what:=str2, LookIn:=xlValues, lookat:=xlPart)
If c Is Nothing And r Is Nothing Then
myFlg = True
End If
Loop
Cells(i, "D") = Cells(myRow, "I")
myFlg = False

Do Until myFlg = True
If myRow = endRow Then
myRow = 1
End If
myRow = myRow + 1
str1 = Left(Cells(myRow, "I"), InStr(Cells(myRow, "I"), ",") - 1)
str2 = Mid(Cells(myRow, "I"), InStr(Cells(myRow, "I"), ",") + 1, 10)
Set c = myRng2.Find(what:=str1, LookIn:=xlValues, lookat:=xlPart)
Set r = myRng2.Find(what:=str2, LookIn:=xlValues, lookat:=xlPart)
If c Is Nothing And r Is Nothing Then
myFlg = True
End If
Loop
Cells(i, "E") = Cells(myRow, "I")
myFlg = False
Next i
End Sub

※ 何度かマクロを実行して、バランスよく配置できないか?やってみましたが
日数にばらつきがどうしても出てきます。
実際に上記マクロを何度も実行してみてください。

※ パートナーの組合せが同じであれば勤労日数はバランスよく配置できますが、
いずれにしても
(1)(2)の条件と(3)の条件がネックになると思います。

※ 何度も何度もマクロを実行してみてください。
運が良ければ勤労日数がある程度均等になるかもしれません。

お手上げです。m(_ _)m
「excellで出来ないでしょうか」の回答画像5
    • good
    • 0

結論から言うと


指定された条件での勤務表作成は、非常に困難(無理)

確かに7人から2人を抜き取る組み合わせだけ考えると
21通り:Excel計算式だと=COMBIN(7,2)

例えば日直のみの勤務表なら21通りをローテすればいいのですが
これに宿直/休日の組み合わせまで加味すると話が複雑に

7人中勤務4人(日直+宿直)ということは休みが3人
7人から休みの3人を抜き出した場合の組み合わせは
35通り
例えばEFGの3人が休みの場合勤務割りは

日直宿直
ABCD
ACBD
ADBC
BCAD
BDAC
CDAB
↑の6通り

全体の組み合わせは
35*6=210通りになります

単純に210通りの組み合わせを考えた場合総当りで勤務表を作成するとその数は
210!= 1.0582362029223656378427428424335e+398

最初に一日を任意で指定た場合でも
209!= 5.039220013916026846870204011588e+395

総当りで条件に合う勤務表作成は量子コンピュータでも使わないと無理
(実際は勤務条件があるので全部計算する必要は無いのですが)


ただ勤務条件を加味した場合であっても

日直宿直
ABCD
の翌日はCDの二人は休み、日直の何方かが休み、なので勤務の組み合わせは
AEFGかBEFGの2パターン*3通り(前日日直者を宿直に配置した場合)
6通りの勤務パターンから過去6日前までの勤務状態から同じ組み合わせの含まないパターンを選択
選択した組み合わせを210通りの一覧から削除

以下同じことの繰り返しで一見可能なようですが
・前日のに直者のどちらを休みにするか
・6通りの勤務パターンから選択可能なものが複数存在する場合どれを選択するか

この選択を誤ると10日目辺りで手詰まりになります

非常に難解なパズルですw

エクセルのマクロで組むには相当の数学力が必要と思います

勤務210通り全パターン:Excelに貼り付けて勤務割作成に利用して下さい
日直宿直休日
ABCDEFG
ACBDEFG
ADBCEFG
BCADEFG
BDACEFG
CDABEFG
ABCEDFG
ACBEDFG
AEBCDFG
BCAEDFG
BEACDFG
CEABDFG
ABCFDEG
ACBFDEG
AFBCDEG
BCAFDEG
BFACDEG
CFABDEG
ABCGDEF
ACBGDEF
AGBCDEF
BCAGDEF
BGACDEF
CGABDEF
ABDECFG
ADBECFG
AEBDCFG
BDAECFG
BEADCFG
DEABCFG
ABDFCEG
ADBFCEG
AFBDCEG
BDAFCEG
BFADCEG
DFABCEG
ABDGCEF
ADBGCEF
AGBDCEF
BDAGCEF
BGADCEF
DGABCEF
ABEFCDG
AEBFCDG
AFBECDG
BEAFCDG
BFAECDG
EFABCDG
ABEGCDF
AEBGCDF
AGBECDF
BEAGCDF
BGAECDF
EGABCDF
ABFGCDE
AFBGCDE
AGBFCDE
BFAGCDE
BGAFCDE
FGABCDE
ACDEBFG
ADCEBFG
AECDBFG
CDAEBFG
CEADBFG
DEACBFG
ACDFBEG
ADCFBEG
AFCDBEG
CDAFBEG
CFADBEG
DFACBEG
ACDGBEF
ADCGBEF
AGCDBEF
CDAGBEF
CGADBEF
DGACBEF
ACEFBDG
AECFBDG
AFCEBDG
CEAFBDG
CFAEBDG
EFACBDG
ACEGBDF
AECGBDF
AGCEBDF
CEAGBDF
CGAEBDF
EGACBDF
ACFGBDE
AFCGBDE
AGCFBDE
CFAGBDE
CGAFBDE
FGACBDE
ADEFBCG
AEDFBCG
AFDEBCG
DEAFBCG
DFAEBCG
EFADBCG
ADEGBCF
AEDGBCF
AGDEBCF
DEAGBCF
DGAEBCF
EGADBCF
ADFGBCE
AFDGBCE
AGDFBCE
DFAGBCE
DGAFBCE
FGADBCE
AEFGBCD
AFEGBCD
AGEFBCD
EFAGBCD
EGAFBCD
FGAEBCD
BCDEAFG
BDCEAFG
BECDAFG
CDBEAFG
CEBDAFG
DEBCAFG
BCDFAEG
BDCFAEG
BFCDAEG
CDBFAEG
CFBDAEG
DFBCAEG
BCDGAEF
BDCGAEF
BGCDAEF
CDBGAEF
CGBDAEF
DGBCAEF
BCEFADG
BECFADG
BFCEADG
CEBFADG
CFBEADG
EFBCADG
BCEGADF
BECGADF
BGCEADF
CEBGADF
CGBEADF
EGBCADF
BCFGADE
BFCGADE
BGCFADE
CFBGADE
CGBFADE
FGBCADE
BDEFACG
BEDFACG
BFDEACG
DEBFACG
DFBEACG
EFBDACG
BDEGACF
BEDGACF
BGDEACF
DEBGACF
DGBEACF
EGBDACF
BDFGACE
BFDGACE
BGDFACE
DFBGACE
DGBFACE
FGBDACE
BEFGACD
BFEGACD
BGEFACD
EFBGACD
EGBFACD
FGBEACD
CDEFABG
CEDFABG
CFDEABG
DECFABG
DFCEABG
EFCDABG
CDEGABF
CEDGABF
CGDEABF
DECGABF
DGCEABF
EGCDABF
CDFGABE
CFDGABE
CGDFABE
DFCGABE
DGCFABE
FGCDABE
CEFGABD
CFEGABD
CGEFABD
EFCGABD
EGCFABD
FGCEABD
DEFGABC
DFEGABC
DGEFABC
EFDGABC
EGDFABC
FGDEABC
    • good
    • 0

こんばんは!



VBAになりますが、一案です。
連続2日勤続をしないようにしてみました。
↓の画像でSheet2に祝日データを作成しておきます。

そして、Sheet1のA2セルに
2015/1/1 と入力 → 「フィル」(メニューバーの右上のΣマークの下にある下向き矢印のアイコン)の右側▼をクリック
→ 連続データの作成 → 「列」を選択 → 停止値に 2015/12/31 と入力しOK

B2セルに
=TEXT(A2,"aaa")
という数式を入れ、条件付き書式 → 新しいルール → 数式を使用して・・・ → 数式欄に
=C2="日直"
という数式を入れ → 書式 → 塗りつぶしから「赤」を選択しOK
B2セルのフィルハンドルでダブルクリック(この段階では「赤」は表示されません)

C2セルに
=IF(OR(WEEKDAY(A2,2)>5,COUNTIF(Sheet2!B:C,A2)),"日直","宿直")
という数式を入れ、C2セルのフィルハンドルでダブルクリック

そして、I列1行目から「人員」を羅列しておきます。

これで下準備は完了です。

次に画面左下の「Sheet1」のSheet見出し上で右クリック → コードの表示 → VBE画面のカーソルが点滅しているところに
↓のコードをコピー&ペースト → Excel画面に戻りマクロを実行してみてください。
(Alt+F8キー → マクロ → マクロ実行です)

Sub 振り分け() 'この行から
Dim i As Long, myRow1 As Long, myRow2 As Long, myCol As Long
Dim c As Range, r As Range, myFlg As Boolean

myRow1 = 0
myRow2 = Cells(Rows.Count, "I").End(xlUp).Row + 1
For i = 2 To Cells(Rows.Count, "A").End(xlUp).Row
If Cells(i, "C") = "日直" Then
myCol = 4
Else
myCol = 6
End If
Do Until myFlg = True
If myRow1 = Cells(Rows.Count, "I").End(xlUp).Row Then
myRow1 = 0
End If
myRow1 = myRow1 + 1
Set c = Cells(i - 1, "D").Resize(, 4).Find(what:=Cells(myRow1, "I"), LookIn:=xlValues, lookat:=xlWhole)
If c Is Nothing Then
myFlg = True
End If
Loop
Cells(i, myCol) = Cells(myRow1, "I")
myFlg = False
Do Until myFlg = True
If myRow2 = 1 Then
myRow2 = Cells(Rows.Count, "I").End(xlUp).Row + 1
End If
myRow2 = myRow2 - 1
Set r = Cells(i - 1, "D").Resize(2, 4).Find(what:=Cells(myRow2, "I"), LookIn:=xlValues, lookat:=xlWhole)
If r Is Nothing Then
myFlg = True
End If
Loop
Cells(i, myCol + 1) = Cells(myRow2, "I")
myFlg = False
Next i
End Sub 'この行まで

※ とりあえず連続勤務はないようにし、全員がほぼ同じ勤務日数になると思います。
※ 日直・宿直のバランスや1週当たりの勤務日数などは無視しています。

こんな感じではどうでしょうか?m(_ _)m
「excellで出来ないでしょうか」の回答画像3

この回答への補足

スミマセン私の説明が足りなかったようです、土・日・祝祭日の日直の後も引き続き別の二名が宿直をします。それもあり
禁止事項にも以下の用にしました。
1)宿直の次に日直は出来ません(連続での出勤になりますので)。

そうなるとマクロもだいぶ変わってきますでしょうか??

補足日時:2014/12/22 16:33
    • good
    • 0
この回答へのお礼

早速のご回答ありがとう御座います、だいぶ考えて頂いたようで恐縮しております。小生の説明不足で申し訳ありません。私も考えてみます。

お礼日時:2014/12/22 16:34

>私どもはある組織の宿日直を総員7名でやっております、宿直も日直も2名で出勤します。


>7名の人員を宿直と日直は常にランダムで行いたい、つまり毎回出来れば同じ組み合わせでやりたくない。
7名の中から2名を選ぶ組み合わせは21種しかありませんので22回目は同じ組み合わせになります。
21本の籤を用意して21日毎に割り振ることになるでしょう。
貼付画像はA~G(7名相当)の中で2種(2名相当)の組み合わせを表にしたものです。

禁則になるときは21日の中で交換すれば年間での回数は均等に近づきますが完全な均等にはなりません。
同じ組み合わせは年間で約17回になります。
Excelで籤引きの代わりをするにはRAND関数、RANDBETWEEN関数(Excel 2007以降)等で乱数を発生させれば良いでしょう。
「excellで出来ないでしょうか」の回答画像2
    • good
    • 0
この回答へのお礼

早速のご回答ありがとう御座いました、仰ることは理解できるので何とかやってみようと思います。

お礼日時:2014/12/21 23:08

1か月単位の変形労働時間制ですね。

1年通しての累算が公平ににするのはわかるのですが、あくまでも1か月以内の暦日数から求まる労働時間の総枠(暦日数×40÷7)に抵触することは許されません(違法)。

で、7名でランダムに動かしてるのに、同じ人の組み合わせが固定的にできるとのこと。希望を受け付けても受付ずでも、ランダムも規則性をもたせれば固定化しないんですがね。

あと、日勤夜勤の入り乱れの勤務予定表は月で回さないで、4週(28日)で回されることです(4週ごとに勤務予定を立て年13回勤務予定を立てることになる、暦月とずれようが、休日時間外労働は各日ごとに把握できるので、月給払いに影響しない)。翌勤務予定表との切れ目は、もちろん現勤務予定表の末と睨み合わせてつるのは当然のことです。

エクセルでは、日勤夜勤を立ててない日は、色付け条件書式にて目立つようにできます。あるいは作業列(横に流すなら行)でcountif関数で確認、月間総労働時間の集計でしょう。それでモレ人数過不足がないか、チェックします。夜勤を入力してその明け休みの自動記入するにはマクロでしょうかね。解決にちょっと遠くてすみません。
    • good
    • 0
この回答へのお礼

早速のご回答ありがとう御座います、何とか工夫してやって見ます。

お礼日時:2014/12/21 22:56

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!