=ЕСЛИ(B2="Exit";0;ИНДЕКС($D$2:$D$14482;ПОИСКПОЗ("Entry";$B$2:$B$14482;0)))
=ЕСЛИ(B2="Entry";0;ИНДЕКС(D2:D14482;ПОИСКПОЗ("Entry";$B$2:$B$14482;0)))

Sub test()
 
Set spis = ThisWorkbook.Worksheets(1)
Set otch = ThisWorkbook.Worksheets(2)
 
 
spis.Cells.Replace " (*)", ""
i = 4
 
On Error Resume Next Do While otch.Cells(i, 2) <> ""
    j = 3
    Do While otch.Cells(3, j) <> "ÑóììГ* Г§Г* Г*åäåëþ"
        r = ""
        
        r = spis.Range(spis.Cells(8, 1), spis.Cells(65536, 1)).Find(otch.Cells(3, j)).Row
        If r <> "" Then
            r2 = r
            If spis.Cells(r2 + 1, 1) Like "" And spis.Cells(r2 + 1, 4) <> "" Then spis.Cells(r2 + 1, 1) = spis.Cells(r2, 1)
            
            spis.Range("F" & r2).FormulaR1C1 = "=RC[-1]-RC[-2]"
            
            Do While spis.Cells(r2 + 1, 1) Like otch.Cells(3, j)
                r2 = r2 + 1
                If spis.Cells(r2 + 1, 1) Like "" And spis.Cells(r2 + 1, 4) <> "" Then spis.Cells(r2 + 1, 1) = spis.Cells(r2, 1)
                spis.Range("F" & r2).FormulaR1C1 = "=RC[-1]-RC[-2]"
            Loop
            sotr = ""
            sotr = spis.Range(spis.Cells(r - 1, 2), spis.Cells(r2, 2)).Find(what:=otch.Cells(i, 2)).Row
            Tot = sotr
            If sotr <> "" Then
                If spis.Cells(sotr + 1, 2) Like "" And spis.Cells(sotr + 1, 4) <> "" Then spis.Cells(sotr + 1, 2) = spis.Cells(sotr, 2)
                Do While spis.Cells(sotr + 1, 2) Like otch.Cells(i, 2)
                    sotr = sotr + 1
                    If spis.Cells(sotr + 1, 2) Like "" And spis.Cells(sotr + 1, 4) <> "" Then spis.Cells(sotr + 1, 2) = spis.Cells(sotr, 2)
                Loop
                spis.Range("G" & Tot).FormulaR1C1 = "=SUM(RC[-1]:R[" & sotr - Tot & "]C[-1])"
            End If
            otch.Cells(i, j) = spis.Cells(Tot, 7).Value
            otch.Range(otch.Cells(i, j), otch.Cells(i, j)).NumberFormat = "hh:mm"
            spis.Cells(Tot, 7) = ""
        End If
    j = j + 1
    Loop
    otch.Range(otch.Cells(i, j), otch.Cells(i, j)).NumberFormat = "d hh:mm"
    otch.Range(otch.Cells(i, j), otch.Cells(i, j)).FormulaR1C1 = "=SUM(RC[-1]:RC[-" & j - 3 & "])"
    
    s = Split(otch.Cells(i, j).Text, " ")
    s2 = Split(s(1), ":")
    
    otch.Range(otch.Cells(i, j), otch.Cells(i, j)).NumberFormat = "@"
    Tot = CStr(s(0) * 24 + s2(0)) & ":" & s2(1)
    otch.Range(otch.Cells(i, j), otch.Cells(i, j)).NumberFormat = "@"
    otch.Cells(i, j) = Tot
    
i = i + 1
Loop
 
spis.Columns(6).Delete
On Error GoTo 0
 
End Sub