VBAで作業時間を把握したい（エクセル）

どなたか知識をお貸し頂けないでしょうか？

作業時間を把握する為に
「H列」に日付けを入力すると開始時刻が同じ行の「V列」に自動入力され
「J列」に日付けを入力すると終了時刻が同じ行の「W列」に自動入力され
同じ行の「X列」に(終了時刻)－(開始時刻)＝(作業時間)が自動入力される
VBAは作成できたのですが、1点問題がでてきました。

休み時間を跨いで作業する場合「X列」に自動入力される(作業時間)から休み時間分を自動で引く
VBAを作成する事は可能でしょうか？

休み時間帯は
10：00～10：15の（15分間）
12：00～12：55の（55分間）
15：00～15：15の（15分間）
になります。

大変申し訳御座いませんが
どなたか、教えて頂けないでしょうか？
宜しくお願いいたします。

No.7 ベストアンサー 回答者： tom04 回答日時： 2018/12/30 16:01

どうもごめんなさい。

実はこちらで検証すると完全でないところがありました。
もう一つ分岐を追加する必要があります。

前回のコードの分岐の最後の部分の
＞End If
と
＞End Select
の間に

Case Is < TimeSerial(15, 0, 0)
　If myEnd > TimeSerial(15, 15, 0) Then
　　.Value = .Value - TimeSerial(0, 15, 0)
　End If

の4行を追加してください。

※　ほとんどないとは思いますが、上記コードがないと
出勤時刻が　15：00～15：15　の場合にお望みの結果にならないと思います。m(_ _)m

この回答へのお礼

度々のご回答有難うございます。
教えて頂いたコードで先ほどじっくり検証させていただきました。
「パーフェクト」です。
すべて私の思っていた通りの結果が完璧に得られました。
明日から実務で使わせて頂きます。
大変助かりました。有難うございました。

お礼日時：2019/01/07 21:32

No.9 回答者： GOMΛFU 回答日時： 2019/01/06 15:16

休み時間分を引いてしまったら正しい作業時間が把握できなくなると思いますが。

No.8 回答者： tom04 回答日時： 2018/12/31 19:24

またまた顔を出してしまいました。

コード内の
＞Cells(i, "Y") = myStart
＞Cells(i, "Z") = myEnd

の2行は消去してください。

こちらで検証するときに、休憩時間内の出勤・退勤がある場合の確認の意味でY・Z列に
計算する開始時刻と終了時刻を表示するようにしていました。

質問に対するしては必要ないものです。m(_ _)m

No.6 回答者： tom04 回答日時： 2018/12/28 21:53

続けてお邪魔します。

すこし分岐を増やしてみました。

前回のSample1のコードは消去し、↓のコードにしてみてください。

Sub Sample2()
　Dim i As Long
　Dim myStart, myEnd
　　For i = 2 To Cells(Rows.Count, "V").End(xlUp).Row
　　　If WorksheetFunction.CountBlank(Cells(i, "V").Resize(, 2)) = 0 Then
　　　　Select Case Cells(i, "V")
　　　　　Case Is < TimeSerial(10, 0, 0)
　　　　　　myStart = Cells(i, "V")
　　　　　Case Is < TimeSerial(12, 0, 0)
　　　　　　myStart = WorksheetFunction.Max(Cells(i, "V"), TimeSerial(10, 15, 0))
　　　　　Case Is < TimeSerial(15, 0, 0)
　　　　　　myStart = WorksheetFunction.Max(Cells(i, "V"), TimeSerial(12, 55, 0))
　　　　　Case Is < TimeSerial(15, 15, 0)
　　　　　　myStart = TimeSerial(15, 15, 0)
　　　　　Case Else
　　　　　　myStart = Cells(i, "V")
　　　　End Select
　　　　Select Case Cells(i, "W")
　　　　　Case Is <= TimeSerial(10, 15, 0)
　　　　　　myEnd = WorksheetFunction.Min(Cells(i, "W"), TimeSerial(10, 0, 0))
　　　　　Case Is <= TimeSerial(12, 55, 0)
　　　　　　myEnd = WorksheetFunction.Min(Cells(i, "W"), TimeSerial(12, 0, 0))
　　　　　Case Is <= TimeSerial(15, 15, 0)
　　　　　　myEnd = WorksheetFunction.Min(Cells(i, "W"), TimeSerial(15, 0, 0))
　　　　　Case Else
　　　　　　myEnd = Cells(i, "W")
　　　　End Select
　　　　With Cells(i, "X")
　　　　　.Value = myEnd - myStart
　　　　　　Select Case myStart
　　　　　　　Case Is < TimeSerial(10, 0, 0)
　　　　　　　　If myEnd > TimeSerial(15, 15, 0) Then
　　　　　　　　　.Value = .Value - TimeSerial(1, 25, 0)
　　　　　　　　ElseIf myEnd > TimeSerial(12, 55, 0) Then
　　　　　　　　　.Value = .Value - TimeSerial(1, 10, 0)
　　　　　　　　ElseIf myEnd > TimeSerial(10, 15, 0) Then
　　　　　　　　　.Value = .Value - TimeSerial(0, 15, 0)
　　　　　　　　End If
　　　　　　　Case Is < TimeSerial(12, 0, 0)
　　　　　　　　If myEnd > TimeSerial(15, 15, 0) Then
　　　　　　　　　.Value = .Value - TimeSerial(1, 10, 0)
　　　　　　　　ElseIf myEnd > TimeSerial(12, 55, 0) Then
　　　　　　　　　.Value = .Value - TimeSerial(0, 55, 0)
　　　　　　　　ElseIf myEnd > TimeSerial(10, 15, 0) Then
　　　　　　　　　.Value = .Value - TimeSerial(0, 15, 0)
　　　　　　　　End If
　　　　　　　End Select
　　　　End With
　　　　　Cells(i, "Y") = myStart
　　　　　Cells(i, "Z") = myEnd
　　　End If
　　Next i
End Sub

※　V・W列に色々時刻を手入力し、上記マクロを検証してみてください。
V・W列にデータを直接入力してもChangeイベントのマクロは実行されませんので
色んなケースを想定して時刻を入力してください。

※　余計なお世話かもしれませんが・・・
労働時間を算出し、給与計算等に利用する場合は、例えば15分刻みで切り捨て！
といった操作が必要になるのではないでしょうか？m(_ _)m

この回答へのお礼

度々のご回答有難うございます。
教えて頂いたコードで試行いたしました。
完璧です。
私の望んでいた通りの動きをしてくれました。
年明けから、実際に業務で使用させていただきたいと思っております。
やはり、ここまでの素晴らしいコードを組むとなるとそれなりに
熟練しないとできませんよね？
今回は大変助かりました。
有難うございました。

お礼日時：2018/12/30 14:54

No.5 回答者： tom04 回答日時： 2018/12/26 22:15

何度もごめんなさい。

No.4で誤記がありました。

＞No.1の二つのコード
ではなく
＞No.3の二つのコード

の間違いでした。m(_ _)m

No.4 回答者： tom04 回答日時： 2018/12/26 22:13

続けてお邪魔します。

＞「X列だけマクロをご自身で実行する」とは・・・

前回のマクロを実行すると、X列に計算結果が表示されます。

今回はシートモジュールでも構わないと思いますので
前回のコード　Sub Sample1()～End Sub　までをこの画面上をドラッグ　→　右クリック　→　コピー！
次にExcel画面の左下の表が入っているシート見出し上で右クリック　→　コードの表示　→　VBE画面の空白部分
（Changeイベントのコードが入っていればその下でも構いません）、に貼り付け！

Excel画面に戻り、マクロを実行してみてください。
（Alt＋F8キー　→　マクロ　→　マクロ実行です）

VBE画面にチェンジイベントのコード（No.1のコード）がある場合はすべて消去し
No.1の二つのコード
チェンジイベントのコードとSub・・・のコードの両方をコピー＆ペーストしてください。

尚、前回投稿後気づいたのですが、
出勤時間・退勤時間が休憩時間の範囲内の場合はお望みの結果とは異なると思います。

もっと細かく分岐する必要があると思います。

※　時間があるとき、ゆっくり考えさせてください。m(_ _)m

No.3 回答者： tom04 回答日時： 2018/12/25 22:53

続けてお邪魔します。

X列の時間計算がお望みどおりにならない！というコトですが、
前回のコードはすべてChangeイベントで処理していますので、その辺でうまく動作しないのかもしれませんね。
ただこちらで今すぐ確認！というわけにはいかないので、
一案ですが、X列だけの操作はご自身でマクロを実行されてみてはどうでしょうか？

チェンジイベントはV・W列だけの操作にして・・・

Private Sub Worksheet_Change(ByVal Target As Range)
　If Intersect(Target, Range("H:H, J:J")) Is Nothing Or Target.Count > 1 Then Exit Sub
　　With Target
　　　If .Value <> "" Then
　　　　If .Column = 8 Then
　　　　　Cells(.Row, "V") = Now()
　　　　Else
　　　　　Cells(.Row, "W") = Now()
　　　　End If
　　　End If
　　End With
End Sub

だけにします。

次に↓のコードのマクロをご自身で実行してみてください。

Sub Sample1()
　Dim i As Long
　　For i = 2 To Cells(Rows.Count, "V").End(xlUp).Row
　　　If WorksheetFunction.CountBlank(Cells(i, "V").Resize(, 2)) = 0 Then
　　　　With Cells(i, "X")
　　　　　.Value = Cells(i, "W") - Cells(i, "V")
　　　　　　Select Case Cells(i, "V")
　　　　　　　Case Is < TimeSerial(10, 0, 0)
　　　　　　　　If Cells(i, "W") >= TimeSerial(15, 15, 0) Then
　　　　　　　　　.Value = .Value - TimeSerial(1, 25, 0)
　　　　　　　　ElseIf Cells(i, "W") >= TimeSerial(12, 55, 0) Then
　　　　　　　　　.Value = .Value - TimeSerial(1, 10, 0)
　　　　　　　　ElseIf Cells(i, "W") >= TimeSerial(12, 0, 0) Then
　　　　　　　　　.Value = .Value - TimeSerial(0, 15, 0)
　　　　　　　　End If
　　　　　　　Case Is < TimeSerial(12, 0, 0)
　　　　　　　　If Cells(i, "W") >= TimeSerial(15, 15, 0) Then
　　　　　　　　　.Value = .Value - TimeSerial(1, 10, 0)
　　　　　　　　ElseIf Cells(i, "W") >= TimeSerial(12, 55, 0) Then
　　　　　　　　　.Value = .Value - TimeSerial(0, 55, 0)
　　　　　　　　End If
　　　　　　　Case Is < TimeSerial(15, 0, 0)
　　　　　　　　If Cells(i, "W") >= TimeSerial(15, 15, 0) Then
　　　　　　　　　.Value = .Value - TimeSerial(0, 15, 0)
　　　　　　　　End If
　　　　　　End Select
　　　　End With
　　　End If
　　Next i
End Sub

これで画像のような感じになります。
おそらくお示しの休憩時間は差し引かれていると思います。

※　何度マクロを繰り返し実行しても構いません。
V・W列にデータが入っていればX列に結果が表示されるはずです。

尚、上記コードは前回のコードそのままで
＞.Row
を
＞ i
に書き換えただけです。m(_ _)m

この回答へのお礼

度々のご回答有難うございます。
大変、感謝しております。
申し訳ございませんが、あと1点だけご教授いただけませんでしょうか？
「X列だけマクロをご自身で実行する」とは
どのようにすれば宜しいでしょうか？
（勉強不足でスミマセン。これから、ちょくちょく勉強していくつもりです・・・）

お礼日時：2018/12/26 21:59

No.2 回答者： tom04 回答日時： 2018/12/23 23:42

No.1です。

投稿後、気づきました。
H・I列ではなく、H・J列でしたね。

前回のコードの
＞If Intersect(Target, Range("H:I")) Is Nothing Or Target.Count > 1 Then Exit Sub
の1行を

＞If Intersect(Target, Range("H:H,J:J")) Is Nothing Or Target.Count > 1 Then Exit Sub
に変更してください。

どうも失礼しました。m(_ _)m

この回答へのお礼

早速のご返答ありがとうございます。
本日、実務中に教えて頂いたコードで実際に検証させていただきました。
下記内容以外は完璧でした。

休み時間を跨ぐ場合、「X列」の作業時間から下記休み時間分が差し引きされないようです。
10：00～10：15の（15分間）
12：00～12：55の（55分間）
15：00～15：15の（15分間）

お忙しい中、大変申し訳ございませんが
あと、どこを変更すれば完璧に実行できますでしょうか？
何かお気付きの点　等があれば教えて頂けませんでしょうか？

お力（知識）をお貸しいただけないでしょうか？
宜しくお願いいたします。

お礼日時：2018/12/25 22:01

No.1 回答者： tom04 回答日時： 2018/12/23 23:35

こんばんは！

一例です。
各列の表示形式はこのみの「時間（時刻）」にしておいてください。
シートモジュールです。

Private Sub Worksheet_Change(ByVal Target As Range)　
　If Intersect(Target, Range("H:I")) Is Nothing Or Target.Count > 1 Then Exit Sub
　　With Target
　　　If .Value <> "" Then
　　　　If .Column = 8 Then
　　　　　Cells(.Row, "V") = Now()
　　　　Else
　　　　　Cells(.Row, "W") = Now()
　　　　End If
　　　End If
　　　If WorksheetFunction.CountBlank(Cells(.Row, "V").Resize(, 2)) = 0 Then
　　　　With Cells(.Row, "X")
　　　　　.Value = Cells(.Row, "W") - Cells(.Row, "V")
　　　　　　Select Case Cells(.Row, "V")
　　　　　　　Case Is < TimeSerial(10, 0, 0)
　　　　　　　　If Cells(.Row, "W") >= TimeSerial(15, 15, 0) Then
　　　　　　　　　.Value = .Value - TimeSerial(1, 25, 0)
　　　　　　　　ElseIf Cells(.Row, "W") >= TimeSerial(12, 55, 0) Then
　　　　　　　　　.Value = .Value - TimeSerial(1, 10, 0)
　　　　　　　　ElseIf Cells(.Row, "W") >= TimeSerial(12, 0, 0) Then
　　　　　　　　　.Value = .Value - TimeSerial(0, 15, 0)
　　　　　　　　End If
　　　　　　Case Is < TimeSerial(12, 0, 0)
　　　　　　　If Cells(.Row, "W") >= TimeSerial(15, 15, 0) Then
　　　　　　　　.Value = .Value - TimeSerial(1, 10, 0)
　　　　　　　ElseIf Cells(.Row, "W") >= TimeSerial(12, 55, 0) Then
　　　　　　　　.Value = .Value - TimeSerial(0, 55, 0)
　　　　　　　End If
　　　　　　Case Is < TimeSerial(15, 0, 0)
　　　　　　　If Cells(.Row, "W") >= TimeSerial(15, 15, 0) Then
　　　　　　　　.Value = .Value - TimeSerial(0, 15, 0)
　　　　　　　End If
　　　　　　End Select
　　　　End With
　　　End If
　　End With
End Sub

※　未検証なので、お望みどおりにならなかったらごめんなさい。m(_ _)m