Question

我有一个表，其中有多个重复的ID（登录）。通常，每次“登录”之后都必须有一个“注销”。如果是，那么我不必做任何事情。如果“登录”后没有“注销”，那么我必须在当天的当天（23:59:59）创建一个。

我有下表：

  Id      Status     Date    
  A      Log in      01.01.2018  01:44:03
  A      Log out     01.01.2018  02:57:03
  C      Log in      01.01.2018  01:55:03
 ser     Log in      01.01.2018  01:59:55
 ser     Log out     03.01.2018  01:59:55
  M      Log in      04.01.2018  01:59:55

该表应如下所示：

 Id      Status     Date    
 A      Log in      01.01.2018  01:44:03
 A      Log out     01.01.2018  02:57:03
 C      Log in      01.01.2018  01:59:03
 C      Log out     01.01.2018  23:59:59  
ser     Log in      01.01.2018  01:59:55
ser     Log out     03.01.2018  01:59:55
 M      Log in      04.01.2018  01:59:55
 M      Log out     04.01.2018  23:59:59

这样的公式

=IF(OR(AND(A2=A3,B2="Log in",B3="Log out"),AND(A2=A1,B2="Log Out",B1="Log in")),"Keep","You need to insert a log out")

可以帮助我查看“登录”后是否存在“注销”，但是她不能帮助我在工作表中插入新行。知道我该怎么做吗？你认为我需要vba吗？

*如果在相同标识的“注销”之后有“注销”，则两个“注销”都将被删除

Answer 1

想象一下以下数据。蓝色栏是我们假定代码应该执行的操作：

Option Explicit

Public Sub AddMissingLogoutLines()
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Worksheets("Data")

    Dim iRow As Long
    iRow = 2 'start in row 2

    Do Until ws.Cells(iRow, "A").Value = vbNullString
        If ws.Cells(iRow, "B").Value = "Log in" Then 'we are in a login line …
            If ws.Cells(iRow + 1, "B").Value = "Log out" And ws.Cells(iRow + 1, "A").Value = ws.Cells(iRow, "A").Value Then
                'login line followed by its logout line
                'this is what we want so we do nothing
            Else 'login line followed by a login line or a mismatching logout line
                'logout is missing add it
                ws.Rows(iRow + 1).Insert Shift:=xlDown
                ws.Cells(iRow + 1, "A").Value = ws.Cells(iRow, "A").Value
                ws.Cells(iRow + 1, "B").Value = "Log out"
                ws.Cells(iRow + 1, "C").Value = DateValue(ws.Cells(iRow, "C").Value) + (1 - (1 / 24 / 60 / 60))
            End If
            iRow = iRow + 2
        Else  'we are in a logout line …
            If ws.Cells(iRow + 1, "B").Value = "Log out" Then 'logout line followed by a logout line
                'logout after logout so delete both
                ws.Range(iRow & ":" & iRow + 1).Delete
            Else 'everything is ok go to next line
                iRow = iRow + 1
                'if you want to remove single `log out` lines with no login line too, then replace the iRow = iRow + 1 above with ws.Rows(iRow).Delete here
            End If
        End If
    Loop
End Sub

运行代码后，我们看到删除了2条Log out行，并创建了Log out行中缺少的2条Log in行。

Answer 2

您可以为此使用VBA：

Option Explicit

' Tools > References > Microsoft Scripting Runtime

' dctIds
'   Id => dctSessions
'           LogIn => dctSession
'                      "Id" => String
'                      "LogIn" => Date
'                      "LogOut" => Date

Public Sub ExtendData()
    Dim dctIds As Dictionary: Set dctIds = New Dictionary
    ReadData dctIds, ThisWorkbook.Worksheets("Input")
    WriteData_v1 dctIds, ThisWorkbook.Worksheets("Output_v1")
    WriteData_v2 dctIds, ThisWorkbook.Worksheets("Output_v2")
End Sub

Private Sub ReadData(dctIds As Dictionary, ewsInput As Worksheet)
    ' Assumption: header in first row, data starts in second row
    Dim r As Long: For r = 2 To ewsInput.UsedRange.Row + ewsInput.UsedRange.Rows.Count - 1
        ' Assumption: Id is in first column
        Dim strId As String: strId = ewsInput.Cells(r, 1).Value
        ' Assumption: Status is in second column
        Dim strStatus As String: strStatus = ewsInput.Cells(r, 2).Value
        ' Assumption: Date is in third column, and ms precision is enough, change data type to Double and use Value2 instead of Value otherwise
        Dim datDate As Date: datDate = ewsInput.Cells(r, 3).Value

        Dim dctSessions As Dictionary
        If dctIds.Exists(strId) = False Then
            Set dctSessions = New Dictionary
            dctIds.Add strId, dctSessions
        Else
            Set dctSessions = dctIds(strId)
        End If

        If strStatus = "Log in" Then
            Dim dctSessionNew As Dictionary: Set dctSessionNew = New Dictionary
            dctSessionNew.Add "Id", strId
            dctSessionNew.Add "Status", strStatus
            dctSessionNew.Add "LogIn", datDate
            dctSessions.Add datDate, dctSessionNew
        ElseIf strStatus = "Log out" Then
            Dim dctSessionLast As Dictionary: Set dctSessionLast = Nothing
            Dim varSessionFound As Variant: For Each varSessionFound In dctSessions.Items
                Dim dctSessionFound As Dictionary: Set dctSessionFound = varSessionFound
                If dctSessionLast Is Nothing Then
                    Set dctSessionLast = dctSessionFound
                ElseIf dctSessionLast("LogIn") <= dctSessionFound("LogIn") Then
                    Set dctSessionLast = dctSessionFound
                End If
            Next varSessionFound
            If Not dctSessionLast Is Nothing Then
                dctSessionLast.Add "LogOut", datDate
            Else
'                Debug.Print "No Log in before Log out in row " & r
                Dim dctSessionOvernight As Dictionary: Set dctSessionOvernight = New Dictionary
                dctSessionOvernight.Add "Id", strId
                dctSessionOvernight.Add "Status", strStatus
                dctSessionOvernight.Add "LogIn", DateValue(datDate) + TimeSerial(0, 0, 0)
                dctSessionOvernight.Add "LogOut", datDate
                dctSessions.Add dctSessionOvernight("LogIn"), dctSessionOvernight

            End If
        Else
            Debug.Print "Invalid Status in row " & r
        End If
    Next r
End Sub

Private Sub WriteData_v1(dctIds As Dictionary, ewsOutput As Worksheet)
    ' Assumption: header in first row, data starts in second row
    Dim r As Long: r = 2
    Dim varSessions As Variant: For Each varSessions In dctIds.Items
        Dim dctSessions As Dictionary: Set dctSessions = varSessions
        Dim varSession As Variant: For Each varSession In dctSessions.Items
            Dim dctSession As Dictionary: Set dctSession = varSession
            ' Assumption: Id is in first column
            ewsOutput.Cells(r, 1).Value = dctSession("Id")
            ' Assumption: Status is in second column
            ewsOutput.Cells(r, 2).Value = dctSession("Status")
            ' Assumption: Date is in third column, and ms precision is enough, change data type to Double and use Value2 instead of Value otherwise
            ewsOutput.Cells(r, 3).Value = dctSession("LogIn")
            r = r + 1
            ' Assumption: Id is in first column
            ewsOutput.Cells(r, 1).Value = dctSession("Id")
            ' Assumption: Status is in second column
            ewsOutput.Cells(r, 2).Value = dctSession("Status")
            ' Assumption: Date is in third column, and ms precision is enough, change data type to Double and use Value2 instead of Value otherwise
            With ewsOutput.Cells(r, 3)
                If dctSessions.Exists("LogOut") Then
                    .Value = dctSession("LogOut")
                Else
                    .Value = DateValue(dctSession("LogIn")) + TimeSerial(23, 59, 59)
                End If
            End With
            r = r + 1
        Next varSession
    Next varSessions
End Sub


Private Sub WriteData_v2(dctIds As Dictionary, ewsOutput As Worksheet)
    ' Assumption: header in first row, data starts in second row
    Dim r As Long: r = 2
    Dim varSessions As Variant: For Each varSessions In dctIds.Items
        Dim dctSessions As Dictionary: Set dctSessions = varSessions
        Dim varSession As Variant: For Each varSession In dctSessions.Items
            Dim dctSession As Dictionary: Set dctSession = varSession
            ' Assumption: Id is in first column
            ewsOutput.Cells(r, 1).Value = dctSession("Id")
            ' Assumption: Status is in second column
            ewsOutput.Cells(r, 2).Value = dctSession("Status")
            ' Assumption: LogIn is in third column, and ms precision is enough, change data type to Double and use Value2 instead of Value otherwise
            ewsOutput.Cells(r, 3).Value = dctSession("LogIn")
            ' Assumption: LogOut is in fourth column, and ms precision is enough, change data type to Double and use Value2 instead of Value otherwise
            With ewsOutput.Cells(r, 4)
                If dctSessions.Exists("LogOut") Then
                    .Value = dctSession("LogOut")
                Else
                    .Value = DateValue(dctSession("LogIn")) + TimeSerial(23, 59, 59)
                End If
            End With
            r = r + 1
        Next varSession
    Next varSessions
End Sub

如您所见，我的宏可以创建输出：

v1：您的要求方式：原始行+其他行以在一天结束时关闭会话

v2：我和其他人推荐的表格格式：每个会话都是一行，其中包含两个日期（登录和注销），如果原始表中缺少第二个日期，则第二个日期为当天结束时间

运行宏后，它将如下所示：

注意：标头（编号，状态等）不是由宏创建的，而是手动创建的。

更新：

在阅读完OP对PEH解决方案的评论后，我修改了错误处理代码（“在退出第x行之前不登录”）。

这样，如果代码发现注销日期，则该代码还将输入登录日期。这很有用，因为如果您允许隔夜的会话，则不足以关闭将在第二天结束的登录事件，但您还应该打开前一天开始的会话。

持续几天的会话仍不受此代码管理（需要分析所有天的日志）。

关于连续三个注销：应该将其视为错误，并且不应被程序代码隐藏，因为它需要进一步调查（为什么会发生？）。

如果重复则插入一个新值

2 个答案: