扫描工作表，将开始时间与上一行结束时间进行比较。

Option Explicit
Sub RemoveDuplicates()
    Dim r As Long, lastrow1 As Long, lastrow2 as long
    Dim d As Long, t0 As Single: t0 = Timer
   
    Application.ScreenUpdating = False
    With ThisWorkbook.Sheets("Sheet1")
        lastrow1 = .Cells(.Rows.Count, "A").End(xlUp).Row
        ' remove blank lines first
        For r = lastrow1 To 2 Step -1
            If Len(.Cells(r, "D") & Cells(r, "E")) = 0 Then
                .Rows(r).Delete
                d = d + 1
            End If
        Next
        
        lastrow2 = .Cells(.Rows.Count, "A").End(xlUp).Row
        For r = lastrow2 To 3 Step -1
            ' compare with row above
            If (.Cells(r, "A") = .Cells(r - 1, "A")) And _
                  (.Cells(r, "C") = .Cells(r - 1, "C")) And _
                  (.Cells(r, "D") = .Cells(r - 1, "E")) Then
                  
                  ' update finish time line above
                  .Cells(r - 1, "E") = .Cells(r, "E")
                  .Rows(r).Delete
                  '.Rows(r).Interior.Color = vbRed
                  d = d + 1
            End If
            
        Next
    End With
    Application.ScreenUpdating = True
   
    MsgBox lastrow1 - 1 & " rows scanned" & vbLf & _
          d & " rows deleted", vbInformation, Format(Timer - t0, "0.0 secs")
End Sub

如果你不想这样做，我能想到的最简单的方法是：
1.首先，按员工和日期排序。
1.创建两个新列（我将使用F和G）
1.在第一个新列和第二行（F2）中，输入公式：

=IF(OR(B2<>B1,C2<>C1,D2<>E1),D2,F1)

1.在第二列（G2）中，输入：

=IF(OR(B3<>B2,C3<>C2,D3<>E2),E2,G3)

1.把公式抄下来。
1.您将看到列现在包含正确的IN时间和正确的OUT时间。
1.复制并粘贴为原始值。
1.使用数据/删除重复项功能进行清理。
一些解释：第一列使用B2<>B1测试这是否是新员工，使用C2<>C1测试这是否是新日期，以及此IN时间是否不同于先前的OUT时间（D2<>E2）。在所有这些情况下，采用来自该行的IN时间（D2）。否则，先前的IN时间（D1）仍然有效。
第二列的功能几乎相同，但它将雇员、日期和OUT时间与NEXT行进行比较。这样，我们就可以收集最后所需的OUT时间。
对于空白行，我只使用自动过滤器来选择它们并手动删除。
您可以尝试将这些步骤保存为宏，但我不确定这是否有效。

请尝试。

Option Explicit
Sub DEMO()
    Dim rngData As Range, arrData, arrRes
    Dim i As Long, j As Long, RowCnt As Long, ColCnt As Long
    Dim resSht As Worksheet
    Dim sKey As String, sNewKey As String, iIndex As Long
    Dim StartRow As Long, EndRow As Long, LastTime2
    ' *** Modify as needed
    Const SOURCE_SHEET = "Data"
    Const OUPUT_SHEET = "Result"
    Const SEP_CHAR = "|"
    ' ***
    Const TIME2_COL = 5 ' Column E
    On Error Resume Next
    Set resSht = Sheets(OUPUT_SHEET)
    On Error GoTo 0
    ' Copy source table to output sheet
    If resSht Is Nothing Then
        Set resSht = Sheets(SOURCE_SHEET).Copy(After:=Sheets(Sheets.Count))
        resSht.Name = OUPUT_SHEET
    Else
        resSht.Cells.Clear
        With Sheets(SOURCE_SHEET)
            .Range(.Cells(1, 1).End(xlToRight), .Cells(.Rows.Count, 1).End(xlUp)).Copy resSht.Range("A1")
        End With
    End If
    ' Sort source table on output sheet
    With resSht
    Set rngData = .Range(.Cells(1, 1).End(xlToRight), .Cells(.Rows.Count, 1).End(xlUp))
    End With
    ' Modify column header as needed
    rngData.Sort key1:="Emp ID", order1:=xlAscending, key2:="Date", _
        order2:=xlAscending, key3:="Time1", _
        order3:=xlAscending, Header:=xlYes
    With rngData
        arrData = rngData.Resize(.Rows.Count + 1).Value
    End With
    RowCnt = UBound(arrData)
    ColCnt = UBound(arrData, 2)
    ReDim arrRes(1 To RowCnt, 1 To ColCnt)
    ' Table header
    For j = 1 To ColCnt
        arrRes(1, j) = arrData(1, j)
    Next j
    iIndex = 2: StartRow = 2
    ' Initial process
    sKey = arrData(2, 1) & SEP_CHAR & arrData(2, 3)
    LastTime2 = arrData(2, 4)
    For i = 2 To RowCnt
        If Len(arrData(i, 4) & arrData(i, 5)) > 0 Or Len(arrData(i, 1)) = 0 Then
            sNewKey = arrData(i, 1) & SEP_CHAR & arrData(i, 3)
            ' [EmpID+Date change] OR [Current Time1 <> Last Time2]
            If sNewKey <> sKey Or Abs(arrData(i, TIME2_COL - 1) - LastTime2) > 0.0000001 Then
                For j = 1 To ColCnt
                    arrRes(iIndex, j) = arrData(StartRow, j)
                Next j
                arrRes(iIndex, TIME2_COL) = arrData(EndRow, TIME2_COL)
                iIndex = iIndex + 1
                StartRow = i
                sKey = arrData(i, 1) & SEP_CHAR & arrData(i, 3)
            End If
            LastTime2 = arrData(i, TIME2_COL)
            EndRow = i
        End If
    Next i
    ' Write data
    With resSht.Range("A1")
        .CurrentRegion.ClearContents
        .Resize(RowCnt, ColCnt).Value = arrRes
    End With
End Sub