按每个用户和日期的上班时间和下班时间修复 Excel 时间表

Question

我有这个：

这有点难读，“I”表示时间开始，“O”表示时间结束。

我想像这样转换它：

我想将每次上班和下班时间与相应的员工 ID 和日期对齐。谢谢

编辑

第一个表中的 I 和 O 不一定交替出现，在相应的 O 出现之前可能有 3 个 I。

结果应该是：1. 缺少的上班和下班时间值应显示为空白 2. 可编辑，以便用户可以填写缺少的上班或下班时间；3.

Answer 1

使用以下配置根据您的数据创建数据透视表：

您可能还需要将该值格式化为时间：

您可能还希望以表格格式显示数据透视表以获得所需的结果：

同时关闭小计和总计的显示：

请注意，如果每个员工每天有多条In/记录，则这将仅显示最新的或记录（通过聚合）。OutInOutMax

Answer 2

好吧，我写了一个不太好看的 VBA，但它似乎确实有效。我发现代码重复了，所以还有优化的空间。目前它被硬编码为输出到第 7 列第 2 行。

Option Explicit

Sub I_O_single_line()

    Dim rng As Range
    Dim counter1 As Integer, counter2 As Integer, counter3 As Integer, LastRow As Integer, WriteRow As Integer, HeaderRow As Integer
    Dim wkb As Workbook
    Dim sht As Worksheet
    Dim Arr() As Variant

    Set wkb = ActiveWorkbook
    Set sht = wkb.Worksheets(1)

    'Last row of header row information
    'set to 0 if no header row

    HeaderRow = 1

    'initializing the first row that the sorted data will be written to
    WriteRow = HeaderRow + 1

    'Finds the last used row
    With sht
        If Application.WorksheetFunction.CountA(.Cells) <> 0 Then
            LastRow = .Cells.Find(What:="*", _
                          After:=.Range("A1"), _
                          Lookat:=xlPart, _
                          LookIn:=xlFormulas, _
                          SearchOrder:=xlByRows, _
                          SearchDirection:=xlPrevious, _
                          MatchCase:=False).Row
        Else
            LastRow = 1
        End If
    End With

    'Resize the array to match your data
    ReDim Arr(LastRow - HeaderRow, 4)

    'Copy the contents of the source data into an arr
    Arr() = Range(Cells(HeaderRow + 1, 1), Cells(LastRow, 4))

    'iterate through each row of the source data
    For counter1 = 1 To (LastRow - HeaderRow)
        'first row of data is potentially a special case
        If counter1 = 1 Then
            'Write out ID and Date
            For counter2 = 1 To 2
                Cells(WriteRow, 6 + counter2) = Arr(counter1, counter2)
            Next counter2
            'Write out Time in appropriate column
            If Arr(counter1, 4) = "I" Then
                Cells(WriteRow, 6 + 3) = Arr(counter1, 3)
            ElseIf Arr(counter1, 4) = "O" Then
                Cells(WriteRow, 6 + 4) = Arr(counter1, 3)
                WriteRow = WriteRow + 1
            End If
        'Check to see if ID changed
        ElseIf Arr(counter1 - 1, 1) = Arr(counter1, 1) Then
            'Check to see if Date has changed
            If Arr(counter1 - 1, 2) = Arr(counter1, 2) Then
                'Write out time in appropriate column
                If Arr(counter1, 4) = "I" Then
                    'Check if previous entry is a repeat
                    If Arr(counter1 - 1, 4) = Arr(counter1, 4) Then
                        'Advance Write a new line
                        WriteRow = WriteRow + 1
                    End If
                    For counter2 = 1 To 3
                        Cells(WriteRow, 6 + counter2) = Arr(counter1, counter2)
                    Next counter2
                ElseIf Arr(counter1, 4) = "O" Then
                    'Check if previous entry is a repeat
                    If Arr(counter1 - 1, 4) = Arr(counter1, 4) Then
                        'Write ID and Date
                        For counter2 = 1 To 2
                            Cells(WriteRow, 6 + counter2) = Arr(counter1, counter2)
                        Next counter2
                    End If
                    Cells(WriteRow, 6 + 4) = Arr(counter1, 3)
                    WriteRow = WriteRow + 1
                End If
            'What to do if date has changed
            Else
                If Arr(counter1 - 1, 4) = "I" Then
                    WriteRow = WriteRow + 1
                End If
                'Write ID and Date
                For counter2 = 1 To 2
                    Cells(WriteRow, 6 + counter2) = Arr(counter1, counter2)
                Next counter2
                'Write out Time in appropriate column
                If Arr(counter1, 4) = "I" Then
                    Cells(WriteRow, 6 + 3) = Arr(counter1, 3)
                ElseIf Arr(counter1, 4) = "O" Then
                    Cells(WriteRow, 6 + 4) = Arr(counter1, 3)
                    WriteRow = WriteRow + 1
                End If
            End If
            'What to do if ID has change
        Else
            If Arr(counter1 - 1, 4) = "I" Then
                WriteRow = WriteRow + 1
            End If
            'Write ID and Date
            For counter2 = 1 To 2
                Cells(WriteRow, 6 + counter2) = Arr(counter1, counter2)
            Next counter2
            'Write out Time in appropriate column
            If Arr(counter1, 4) = "I" Then
                Cells(WriteRow, 6 + 3) = Arr(counter1, 3)
            ElseIf Arr(counter1, 4) = "O" Then
                Cells(WriteRow, 6 + 4) = Arr(counter1, 3)
                WriteRow = WriteRow + 1
            End If
        End If
    Next counter1
End Sub