時間帯の重複を除いた集計について

工場で作業日報を集計しており、製造番号毎に開始と終了の日時を記録しています。
作業を並行して行うこともあり、作業している時間が重複(オーバーラップ)します。
下記のNO.1と3、NO.5と7が重複(オーバーラップ)しています。
日付毎、担当者毎に出勤時間に対して作業に携わった時間の比率を計算したいのですが、
単純に作業時間を合計すると出勤時間をオーバーしてしまうため困っております。
重複した時間を除いた時間の合計をしたいのですが、方法はありますでしょうか？
30名程度の工場で、日々、このようなデータが300件ほどあり、夜勤も一部工程で発生します。
関数でもVBAでも構いません。環境はWin10　Excel365になります

NO　 日付　　 作業者　 製造番号　　　開始日時　　　 終了日時 　 作業時間(分)
1 　1月20日 山田 　　A051　　2020/1/20 9:00 2020/1/20 10:18　　　 78
2 　1月20日 田中 　　C005 　2020/1/20 9:00　2020/1/20 11:40 　 140
3 　1月20日 山田 　　F012 　2020/1/20 9:45　2020/1/20 11:50 　 125
4 　1月20日 清水 　　E042 　2020/1/20 10:00　2020/1/20 11:30 　 90
5 　1月20日 田中 　　K123 　2020/1/20 13:00　2020/1/20 14:45 　105
6 　1月20日 清水 　　H023 　2020/1/20 13:00　2020/1/20 15:25 　145
7 　1月20日 田中 　　J102 　2020/1/20 14:00　2020/1/20 16:30 　150
8 　1月20日 佐藤 　　L321 　2020/1/20 13:00　2020/1/20 14:42　　 102

質問者からの補足コメント

• 多少ですが、マクロは使ったことはございます。宜しくお願いします。

  No.1の回答に寄せられた補足コメントです。 補足日時：2020/01/25 14:58

• ご連絡ありがとうございます。
  ご指摘の通り日付、担当者、作業時間合計になります。
  集計結果は⑤の別シート「集計結果」でお願いします。
  宜しくお願い致します。

  No.2の回答に寄せられた補足コメントです。 補足日時：2020/01/25 15:29

No.3 ベストアンサー 回答者： GooUserラック 回答日時： 2020/01/25 23:45

元データのレイアウトなどが下図のような物を想定したものです。

※ 24時を超えたデータは想定していません
※ 回答ではありませんが NO2 の提示の作業時間(分)に間違いがありました。
　（Ｇ列の計算式を「=(F2-E2)*1440」ようにされると良いと思います）
※ 今回のようにそれほど複雑ではない物はもっと簡単な比較で済むかもしれませんが、１日分の分単位の配列を作りフラグを立てて、フラグの数をカウントするようにしました。これならばいくら複雑でも問題が無いはずです。

Option Explicit

Dim 時分(1439) As Byte

Sub Sample()
Const データシート名 As String = "Sheet1" '環境に合わせて変更して下さい
Dim 始 As Boolean
Dim 終 As Boolean
Dim 分 As Long
Dim 行 As Long
Dim ワークシート As Worksheet
　For Each ワークシート In Worksheets
　　If ワークシート.Name = "集計結果" Then
　　　Application.DisplayAlerts = False
　　　Sheets("集計結果").Delete
　　　Application.DisplayAlerts = True
　　　Exit For
　　End If
　Next
　Sheets(データシート名).Copy After:=Sheets(Sheets.Count)
　ActiveSheet.Name = "集計結果"
　Cells.Sort _
　　Key1:=Range("B2"), Order1:=xlAscending, _
　　Key2:=Range("C2"), Order2:=xlAscending, _
　　Header:=xlYes
　For 行 = 2 To Cells(Rows.Count, 1).End(xlUp).Row
　　始 = False
　　If Cells(行 - 1, 2).Value <> Cells(行, 2).Value Then 始 = True
　　If Cells(行 - 1, 3).Value <> Cells(行, 3).Value Then 始 = True
　　If 始 Then Erase 時分
　　分 = 分数(Cells(行, 5).Value, Cells(行, 6).Value)
　　終 = False
　　If Cells(行, 2).Value <> Cells(行 + 1, 2).Value Then 終 = True
　　If Cells(行, 3).Value <> Cells(行 + 1, 3).Value Then 終 = True
　　If 終 Then
　　　Cells(行, 7).Value = 分
　　Else
　　　Cells(行, 7).ClearContents
　　End If
　Next
　Range("A:A,D:F").Delete shift:=xlToLeft
　Cells.Sort _
　　Key1:=Range("C2"), Order1:=xlAscending, _
　　Header:=xlYes
　Range(Cells(Cells(Rows.Count, 3).End(xlUp).Row + 1, 1), Cells(Rows.Count, 3)).Delete shift:=xlUp
　Cells.Sort _
　　Key1:=Range("A2"), Order1:=xlAscending, _
　　Key2:=Range("B2"), Order2:=xlAscending, _
　　Header:=xlYes
End Sub

Function 分数(開始 As Date, 終了 As Date) As Long
Dim 始分 As Long
Dim 終分 As Long
Dim 分 As Long
　始分 = TimeValue(開始) * 1440
　終分 = TimeValue(終了) * 1440
　For 分 = 0 To 1439
　　If 分 >= 始分 Then
　　　If 分 < 終分 Then
　　　　時分(分) = 1
　　　End If
　　End If
　　If 時分(分) = 1 Then 分数 = 分数 + 1
　Next
End Function

この回答へのお礼

回答頂きまして誠にありがとうございます。
こちらの要望を完璧にご理解頂き、完璧な回答を頂きました。
大変感謝しております。マクロの内容が私には難しいので
勉強しながら理解したいと思います。
本当に迅速に回答を頂きまして、重ねて御礼申し上げます。

お礼日時：2020/01/26 00:43

No.6 回答者： GooUserラック 回答日時： 2020/01/26 00:34

No.5 の補足

「開始日時」「終了日時」の日付の部分はカットして時間しか見ていませんので、２４時を超えているかの判断は「開始日時」と「終了日時」の関係で判断しています。
「開始日時」<「終了日時」の場合は２４時を超えていない
「開始日時」>=「終了日時」の場合は２４時を超えている

例えば「開始日時」=「2020/1/20 15:00」、「終了日時」=「2020/1/20 13:00」なんて言う変なデータが有っても２２時間働いたことになります。
これについては「エラー」出すことも、「開始日時」と「終了日時」を入れ替えて処理する事も可能ですが必要ですか？

この回答へのお礼

ご連絡ありがとうございます。
補足頂きました開始と終了が逆転している場合は可能であれば「エラー」として頂ければありがたいです。
何卒よろしくお願い申し上げます。

お礼日時：2020/01/26 01:14

No.5 回答者： GooUserラック 回答日時： 2020/01/26 00:22

最大の集計労働時間が、24時間を超えないもの（例えば１６時に出勤した方は翌日の１６時前には退勤している）に対応した物に修正しました。

※「Function 分数」のみ差替えて下さい。

Function 分数(開始 As Date, 終了 As Date) As Long
Dim 始分 As Long
Dim 終分 As Long
Dim 分 As Long
　始分 = TimeValue(開始) * 1440
　終分 = TimeValue(終了) * 1440
　If 始分 < 終分 Then
　　For 分 = 0 To 1439
　　　If 分 >= 始分 Then
　　　　If 分 < 終分 Then
　　　　　時分(分) = 1
　　　　End If
　　　End If
　　　If 時分(分) = 1 Then 分数 = 分数 + 1
　　Next
　Else
　　For 分 = 始分 To 1439
　　　時分(分) = 1
　　Next
　　For 分 = 0 To 1439
　　　If 分 < 終分 Then
　　　　時分(分) = 1
　　　End If
　　　If 時分(分) = 1 Then 分数 = 分数 + 1
　　Next
　End If
End Function

No.4 回答者： GooUserラック 回答日時： 2020/01/25 23:51

すみません「夜勤も一部工程で発生します。

」を見逃していました。
２４時を超えてしまう事もあるのでしょうか？
もし超える場合でも開始日時から終了日時まで２４時間以内に収まるのでしょうか？

No.2 回答者： GooUserラック 回答日時： 2020/01/25 15:20

日付、担当者、作業時間合計の表を作れば良いのでしょうか？

その表は次の内どのようにしたら良いのでしょうか？以下から選択して下さい。
① 同じシートの○列から表を作成する（○にあたる列を提示して下さい）
② 現在の表の上位のデータの部分にまとめて表示する。
③ 現在の表の下位のデータの部分にまとめて表示する。
④ 現在の表に差分の形で表示する。
　No.1 ⇒ 78、No.3 ⇒ 92、No.5 ⇒ 105、No.7 ⇒ 90
⑤ 別のシートに表を作る（シート名を提示して下さい）
⑥ その他（具体的に説明して下さい）

No.1 回答者： mike_g 回答日時： 2020/01/25 13:51

確認させてください。

貴方には、マクロの素養(心得)がおありですか？