Вставьте новое значение, если есть дубликат - PullRequest
0 голосов
/ 27 февраля 2019

У меня есть таблица с несколькими дубликатами (логин) для идентификатора.Обычно после каждого «входа в систему» ​​должен быть «выход из системы».Если да, то мне не нужно ничего делать.Если после «входа в систему» ​​нет «выхода из системы», то я должен создать его в тот же день (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")

может помочь мне увидеть, существует ли после "входа в систему" журналout ", однако она не помогает мне вставить новую строку в лист.Есть идеи, как я могу это сделать?Как вы думаете, мне нужен vba?

* если после «выхода из системы» для одного и того же идентификатора происходит «выход из системы», оба выхода из системы будут удалены

Ответы [ 2 ]

0 голосов
/ 27 февраля 2019

Вы можете использовать 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: рекомендуемый мной и другими формат таблицы: каждый сеанс представляет собой строку с двумя датами (вход и выход), где вторая дата - конецдня, если отсутствует в исходной таблице

После запуска макроса это будет выглядеть следующим образом:

Log In and Out Picture

Примечание.заголовок (Id, Status и т. д.) был создан не макросом, а вручную.

Обновление:

Прочитав комментарии ОП к решению PEH, я изменилкод обработки ошибки («Нет входа до выхода из строки x»).

Таким образом, код также будет вводить даты входа в систему, если он найдет даты выхода из системы.Это полезно, потому что если вы разрешаете сеансы с ночевкой, недостаточно закрыть события входа в систему, которые завершатся на следующий день, но вы также должны открыть сеансы, которые были начаты накануне.

Сеансы, длящиеся несколько днейвсе еще не управляется этим кодом (для этого потребуется анализировать журналы всех дней).

Относительно трех последовательных выходов из системы: это следует считать ошибкой и не должно быть скрыто кодом программы, поскольку онотребует дальнейшего расследования (почему это произошло?).

0 голосов
/ 27 февраля 2019

Представьте себе следующие данные.Синяя колонка - это то, что мы предполагаем, что код должен делать:

enter image description here

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 строкбыли удалены и были созданы 2 недостающие строки Log out, отсутствующие для строк Log in.

enter image description here

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...