[[20181003112202]]　『シフト表の作成につきまして』（今泉）　ページの最後に飛ぶ

『シフト表の作成につきまして』（今泉）

現在、介護施設でのシフト表の作成支援システムを作成しています。
行き詰ってしまったので質問させてください。

シート1にシフト表
シート2に職員の勤務表

があります。

〇シフト表のイメージ

    A　　 B　　 C　　~　 AQ
1  10/1
2        8:00　8:15　~　18:00
3  職員1　　
4  職員2　
5  職員3
6  職員4
7  職員5

・A1セルにシフト表を作成する日
・2行目に8:00~18:00まで15分おきのタイムチャート

〇勤務表のイメージ

  　A　　　B　　　C　　　D　　E　　F　G　　H ~ AI
1 　　　　始業　終業　　休憩　01　02　03　04 ~ 31
2 職員1　09:00　17:00 　1.0　 出  出　休　出　 出
3 職員2　08:00　17:00   1.0   P　 出  出　P　  出 
4 職員3　13:00　17:00   0.5   出  出　休　出   出
5 職員4　09:00　13:00　 0.0   出  出　休　出　 出
6 職員5　08:00　17:00   1.0   休　出  出　出　 出

・A2~全職員の名前
・B2~各職員の業務開始時間
・C2~各職員の業務終了時間
・D2~各職員の休憩時間
・PとはPM休み、12:00で業務終了

1　職員取込のボタンをシフト表の1行目のW列あたりに配置
2　ボタンをクリックすることでA1の日付に出勤の職員（勤務表の出、Pの人）をシート1のA3以下に転記
3　各職員の開始時間までと終了時間以降の行を黒く塗りつぶす

上記内容を自動化したいのですが、可能でしょうか。

特にPの人の自動塗りつぶしの時間帯の変更は実現可能なのでしょうか？

以下にこちらがネットで検索したコードを少々調整したものを貼らせていただきます。

Sub 勤務表取込()

'勤務表から当日出勤者を抽出して行動表に反映させる
'抽出元の1F勤務表マスタ、2F勤務表マスタのB3～B40まで名前を参照
'抽出先は1F行動表、2F行動表のB3以下

Dim gyo1 As Integer '変数の定義　1F勤務表マスタの行番号をカウント
Dim gyo2 As Integer '変数の定義　1F行動表の行番号をカウント

Application.ScreenUpdating = False '画面更新の無効
Worksheets("1F勤務表マスタ").Select '1F勤務表マスタを選択

If Range("i" & gyo1) = "出" Then '抽出データの出か判定
Worksheets("1F行動表").Range("a" & gyo2) = Range("a" & gyo1) '1F行動表に編集する
gyo2 = gyo2 + 1 '1F行動表の編集する行を次の行にする

ElseIf Range("i" & gyo1) = "P" Then '抽出データのPか判定
Worksheets("1F行動表").Range("a" & gyo2) = Range("a" & gyo1)
gyo2 = gyo2 + 1 '1F行動表の編集する行を次の行にする

ElseIf Range("i" & gyo1) = "A" Then '抽出データのAか判定
Worksheets("1F行動表").Range("a" & gyo2) = Range("a" & gyo1)
gyo2 = gyo2 + 1 '1F行動表の編集する行を次の行にする
End If

gyo1 = gyo1 + 1 '参照するデータを１行ずつ増やす。
Loop

Application.ScreenUpdating = True '画面更新を有効にする

End Sub

I列の出勤データの抽出しかできていません。
日付の指定と塗りつぶしは実装できていません。

もし可能でしたらご教授をお願いいたします。

＜使用 Excel：Excel2016、使用 OS：Windows10 ＞

言葉を統一してください。似た言葉が入り混じっていて、実態が掴めません。
シート1（シフト表）
シート2（職員の勤務表）
勤務表
1F勤務表マスタ
2F勤務表マスタ
1F行動表
2F行動表

・コーディングの中では2シートしか名前が出てきませんが、条件を読むと7シートもあります。どれとどれが同じシートで、合計何シートなのですか？
・ボタンを押すと、シフト表の情報を、勤務表の日付列に転記するようですが、転記元はシフト表であり、I列に「出」「P」「A」と書いてあるのですか？列は時間であり、I列に特別な意味があるようには見えないのですが…。
・シフト表のＡ列、つまり職員名を、勤務表のＡ列に代入しているようですが、Ａ列はどちらも最初から手入力されているのではないのですか？名前だけ転記しても、全く意味のない表にしかならないと思うのですが…。
・職員3は、常に13:00からなのですか？ならば毎日Pにしても良いのでは？

コードを全く無視してレイアウトだけ見ると、勤務表の始業と終業に応じてシフト表のセルを塗りたいのかなぁ？、と思えるのですが、毎日同じ時間ならば、塗りつぶしても毎日同じ結果にしかならず、15分で1列使っている意味が判りません。（午前と午後の2列で足りたり？） 15分単位で塗りたいならば、休み時間はどう判定し、どう塗るのでしょう？（0の人とか0.5の人とか…）

休息も何時から何時までとか決まっているのですかね？シフトというくらいなら時間をずらしそうですが、それを表現する元データがありません。

何をどうしたいのか決める前にコーディングし始めてしまって、わけが分からなくなっているという印象です。どういう元データから、どういう出力にしたいのかのレイアウトを明らかにしましょう。そして、現状は一人につき始業、終業の時間は1つですが、実は毎日、始業と終業の時間は変わってきたりしませんか？現状の表で、実態を表現しきれていないならば、何を作っても無駄に終わってしまうので、まずは出力結果のレイアウトから考えてみてください。
（???） 2018/10/03(水) 16:29

Sub main()

    '"シフト表"と"勤務表"の２シート構成が前提
    Dim col As Long, i As Long, d, r As Range, c As Range, s As Date, e As Date
    d = Sheets("シフト表").Range("A1").Value
    Sheets("シフト表").Cells.Clear
    Sheets("シフト表").Range("A1").Value = d
    Set r = Sheets("シフト表").Range("B2")
    r.Value = TimeValue("8:00:00")
    r.NumberFormatLocal = "h:mm;@"
    Do
        Set r = r.Offset(, 1)
        r.Value = DateAdd("n", 15, r.Offset(, -1).Value)
        r.NumberFormatLocal = "h:mm;@"
        If r.Value = TimeValue("18:00:00") Then Exit Do
    Loop
    For Each c In Sheets("勤務表").Rows(1).SpecialCells(2)
        If Val(c.Text) = Day(Sheets("シフト表").Range("A1").Value) Then col = c.Column: Exit For
    Next c
    If col = 0 Then MsgBox "該当日がありません": Exit Sub
    For Each c In Sheets("勤務表").Columns(col).SpecialCells(2)
        Select Case Trim(c.Value)
            Case "出"
            Sheets("シフト表").Range("A" & i + 3).Value = c.EntireRow.Cells(1)
            s = c.EntireRow.Cells(2).Value
            e = c.EntireRow.Cells(3).Value
            For Each r In Sheets("シフト表").Rows(2).SpecialCells(2)
                If r.Value < s Then Sheets("シフト表").Cells(i + 3, r.Column).Interior.Color = vbBlack
                If r.Value > e Then Sheets("シフト表").Cells(i + 3, r.Column).Interior.Color = vbBlack
            Next r
            i = i + 1
            Case "P"
            Sheets("シフト表").Range("A" & i + 3).Value = c.EntireRow.Cells(1)
            s = c.EntireRow.Cells(2).Value
            e = TimeValue("12:00:00")
            For Each r In Sheets("シフト表").Rows(2).SpecialCells(2)
                If r.Value < s Then Sheets("シフト表").Cells(i + 3, r.Column).Interior.Color = vbBlack
                If r.Value > e Then Sheets("シフト表").Cells(i + 3, r.Column).Interior.Color = vbBlack
            Next r
            i = i + 1
        End Select
    Next c
End Sub
（mm） 2018/10/04(木) 10:41

??様

混乱させてしまい申し訳ございません。

当事業所は2階立てで、毎日の勤務表とシフト表が1Fと2Fで分かれておりましたが、質問文ではその旨にふれておりませんでした。
大変わかりにくい内容となってしまいお詫び申し上げます。

コードの中の
勤務表
1F勤務表マスタ
2F勤務表マスタ
1F行動表
2F行動表

これを置換するのを忘れておりました。

職員の勤務表=
勤務表(1Fと2Fを混合させたもの)
1F勤務表マスタ
2F勤務表マスタ

シフト表=
1F行動表
2F行動表

また、勤務の種類に関しましても漏れがございました。
「出」……勤務表の始業～終業
「P」……始業～12:00まで
「A」……13:00～終業まで

始業と終業は特例を除きこのパターンのみです。

以下、ブックの内容と行いたい作業の流れです。

・シート1「シフト表」(1F用と2F用)
・シート2「勤務表」(1F用と2F用)

1　シフト表のA2以下は最初は空欄。

2　シート1「シフト表」のA1に、作成したい日付を手入力

3　シート2「勤務表」内に設置したボタンを押す

4　シフト表のA2以下に、A1の日に出勤する職員名を転記したい

5　同時に勤務時間以外の部分を塗りつぶしたい

ボタンに埋め込んだコードではI列の勤務日の出勤職員は抽出できるのですが、
シート2の1行目からシート1のA1の日付と同じ日付を選択して勤務する職員を抽出、というコードが作成できていなかったのです。

15分単位で列を使っているのは、業務時間内に15分単位で行う勤務がある為です。

1Fと2Fは勤務内容が大幅に違い、行き来もないため別ファイルにしています。

職員抽出と勤務時間の反映を行った後、塗りつぶしていない部分に一日の業務を組み込むのです。

休憩時間もその業務時間内になるべく被りすぎないように11:30～13:00の間に配備しています。

業務内容と休憩の配備は現状、手作業ですが、あまりにも業務内容が多すぎる事から、まずその前段階の
当日出勤予定の職員の抽出を行いたかったというわけです。

現在はすべてを目視確認の手作業で行っております。

もしよろしければ、上記内容からご教授いただくか、まだ足りていない情報がございましたら教えて頂ければ幸いです。

?o様

ご返信ありがとうございます。

早速試させていただきます。

分かりづらい情報で申し訳ございませんでした。
（今泉） 2018/10/04(木) 10:59

その条件なら、mmさんのコードでほぼ達成しているようですね。 If r.Value > e Then の2か所を >= に変える事と、A の処理を追加すればよさそうです。
（???） 2018/10/04(木) 11:47

ご返信ありがとうございます。

mm様のコードで目的が達成されました。

ありがとうございました。

？？？様もご指導まことに為になりました。

とても助かりました。

後学のためにも参考とさせていただきます。
（今泉） 2018/10/04(木) 14:25

コメント返信：

[ 一覧(最新更新順) ]

[[20181003112202]] 『シフト表の作成につきまして』（今泉） ページの最後に飛ぶ

[[20181003112202]]　『シフト表の作成につきまして』（今泉）　ページの最後に飛ぶ