ユーザーおよび日付ごとのタイムアウトおよびタイムアウトによるExcelタイムシートの修正

私はこれを持っています：

これは読むのが難しいです、「私」はタイムアウトを意味し、「O」はタイムアウトを意味します。

これを次のように変形したいと思います。

その都度、それぞれの従業員IDと日付に合わせてタイムアウトします。ありがとう

編集

最初のテーブルの私とOは、必ずしも交互に並んでいるわけではありません。それぞれのOが現れる前に、3つのIがあるかもしれません。

結果は次のようになります。 1.入力および出力時間の欠落値は空白として表示されます ユーザーが欠けている時間の内外を記入できるように編集可能。 3. t

次の設定でデータからピボットテーブルを作成します。

おそらく時間として値をフォーマットする必要があるでしょう。

また、ピボットテーブルを表形式で表示して目的の結果を得ることもできます。

小計との表示もオフにします。総計：

複数ある場合 In / Out 従業員1人当たりの1日当たりの記録。これは最新のものだけを表示します。 In または Out レコード（との集約による） Max ）

よく私は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