Учет рабочего времени, входы и выходы в одной ячейке

Public Sub www()
    Dim d1 As Date, d2 As Date
    HowDay = CInt(InputBox("Сколько дней в месяце?" & vbNewLine & "Введите число"))
    For i = 2 To Cells(Rows.Count, 1).End(xlUp).Row
        For j = 4 To HowDay + 4
            If Right(Trim(Cells(i, j)), 1) = "-" And Left(Trim(Cells(i, j + 1)), 1) <> "-" Then
                arr = arr & Trim(Cells(i, j)) & ";"
            Else
                arr = arr & Trim(Cells(i, j))
            End If
        Next j
 
        For x = 0 To UBound(Split(arr, ";")) - 1
        On Error GoTo Stroka
            If Left(Trim(Split(arr, ";")(x)), 1) = "-" Then
                d1 = "00:00:00"
                d2 = TimeValue(Split(Split(arr, ";")(x), "-")(1) & ":" & "00")
            ElseIf Right(Trim(Split(arr, ";")(x)), 1) = "-" Then
                d1 = TimeValue(Split(Split(arr, ";")(x), "-")(0) & ":" & "00")
                d2 = "23:59:59"
            Else
                d1 = TimeValue(Split(Split(arr, ";")(x), "--")(0) & ":" & "00")
                d2 = TimeValue(Split(Split(arr, ";")(x), "--")(1) & ":" & "00")
            End If
 
            TM = CDate(Abs(d1 - d2))
            gr = gr + TM
        Next x
 
        Cells(i, HowDay + 4).Value = Format(gr, "hh:mm")
        Cells(i, HowDay + 4).NumberFormat = "hh:mm"
        arr = ""
        gr = 0
    Next i
    
Exit Sub
 
Stroka:
    MsgBox "Произошла ошибка: " & "строка " & i & vbNewLine _
    & "часть данных " & Split(arr, ";")(x)
End Sub