コードを回答の中に残したいので、再回答させて頂きます。 昨日の懸念点については、最後に返信をコピペしておきます。 Sub test() Dim tbl As Variant Dim rng As Range Dim r As Long Dim i As Integer, j As Integer Dim k As Variant Dim h1 As Integer, m1 As Integer Dim h2 As Integer, m2 As Integer Dim b As Integer With ActiveSheet .Range("J8:P31").ClearContents tbl = .Range("J8:P31") Set rng = .Range("J7:P7") For r = 8 To .Cells(Rows.Count, 2).End(xlUp).Row k = Application.Match(.Cells(r, 2).Value & "-" & .Cells(r, 3).Value, rng, 0) If IsError(k) = False Then h1 = Hour(.Cells(r, 4).Value) m1 = Minute(.Cells(r, 4).Value) h2 = Hour(.Cells(r, 5).Value) m2 = Minute(.Cells(r, 5).Value) i = h1 + 1 If m1 = 0 And h1 = h2 Then tbl(i, k) = tbl(i, k) + m2 ElseIf m1 = 0 And h1 <> h2 Then tbl(i, k) = 60 ElseIf m1 > 0 And h1 = h2 Then tbl(i, k) = tbl(i, k) + m2 - m1 Else tbl(i, k) = tbl(i, k) + 60 - m1 End If j = i + h2 - h1 If j > i Then If m2 = 0 And h1 <> h2 Then tbl(j, k) = 60 ElseIf m2 > 0 And h1 = h2 Then tbl(j, k) = tbl(j, k) + m2 - tbl(i, k) Else tbl(j, k) = tbl(j, k) + m2 End If For b = i + 1 To j - 1 tbl(b, k) = 60 Next b End If End If Next r .Range("J8:P31") = tbl End With Application.ScreenUpdating = True End Sub Q:出来ました。 21列目のデータ（A 2 23:30 24:00 0：30）を削除すればマクロ起動しました。 A:E21は、セルの書式を [h]:mm にしてあれば、エラーなく全部処理するはずです。 Q:セルの書式を『ユーザー定義で「[h]:mm」』としましたが、やはり同じエラーが出てしまいました。 一番下のみ削除すれば動くのですが。 下記のように書き換えますと起動しました。 E行21列：24:00→23:59 F行21列：0:29 A:E21は、セルの書式を [h]:mm にして 24:00と入力です。 E21をクリックしたら、上の数式バーで 1900/1/1 0:00:00 になっていますか？ こちらではその状態で最後までエラーなく、貴方が示した通りの結果が出ておいます。 Q:24:00の表記を0:00に打ち換えますと出来ました。