VBA: удалить дубликаты ячеек на основе идентификатора - PullRequest
0 голосов
/ 19 февраля 2019

У меня есть таблица с несколькими дубликатами (логин) для идентификатора.Мне нужно удалить дубликаты до последнего входа в систему, как в примере ниже.

У меня есть следующая таблица:

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
C      Log in      01.01.2018  01:59:03
C      Log in      01.01.2018  01:59:03 
D      Log in      01.01.2018  01:59:03 
E      Log in      01.01.2018  01:59:03 
E      Log out     01.01.2018  01:59:03 

Таблица должна выглядеть следующим образом:

Id      Status     Date    
A      Log in      01.01.2018  01:44:03
A      Log out     01.01.2018  02:57:03
E      Log in      01.01.2018  01:59:03 
E      Log out     01.01.2018  01:59:03 

Чтобы сделать это, я попытался использовать следующий код.Проблема в том, что он удалит дубликаты, но первый логин для идентификатора останется, а не последний.Если я начну цикл «for» с последней ячейки до первой, все будет в порядке, но это невозможно (удалить дубликаты в противоположном направлении).Любая идея, как я могу это исправить?Спасибо!* Идентификатор D удален, поскольку после входа в систему должен быть выполнен выход из системы.

Sub RemoveDuplicates()
    Dim xRow As Long
    Dim xCol As Long
    Dim x2Row As Long
    Dim x2Col As Long
    Dim xrg As Range
    Dim xrg2 As Range
    Dim xl As Long
    Dim x2 As Long

    Set xrg = Application.InputBox("Select a range:", "Kutools for Excel", _
                                    ActiveWindow.RangeSelection.AddressLocal, , , , , 8)    
    Set xrg2 = Application.InputBox("Select a range:", "Kutools for Excel", _
                                    ActiveWindow.RangeSelection.AddressLocal, , , , , 8)

    xRow = xrg.Rows.Count + xrg.Row - 1
    x2Row = xrg2.Rows.Count + xrg2.Row - 1
    xCol = xrg.Column
    x2Col = xrg2.Column
    'MsgBox xRow & ":" & xCol
    Application.ScreenUpdating = False


    For xl = xRow To 2 Step -1 
        If Cells(xl, xCol) = Cells(xl - 1, xCol) Then
            If Cells(xl, x2Col) = Cells(xl - 1, x2Col) Then
                Cells(xl, xCol) = ""
                Cells(xl, x2Col) = ""                
            End If
        End If
    Next xl

Ответы [ 4 ]

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

Вы можете попробовать:

Sub test()

    Dim ID As String, Status As String, strDate As String
    Dim LastrowA As Long, LastrowE As Long, i As Long
    Dim cell As Range, rngToSearch As Range

    With ThisWorkbook.Worksheets("Sheet5")

        LastrowA = .Cells(.Rows.Count, "A").End(xlUp).Row

        For i = 2 To LastrowA

            ID = .Range("A" & i).Value
            Status = .Range("B" & i).Value
            strDate = .Range("C" & i).Value

            If Status = "Log in" Then

                Set rngToSearch = .Range("A" & i + 1)

                For Each cell In rngToSearch

                    If cell.Value = ID And cell.Offset(0, 1).Value <> Status Then

                        LastrowE = .Cells(.Rows.Count, "E").End(xlUp).Row

                        .Range("E" & LastrowE + 1).Value = ID
                        .Range("F" & LastrowE + 1).Value = Status
                        .Range("G" & LastrowE + 1).Value = strDate
                        .Range("E" & LastrowE + 2).Value = cell.Value
                        .Range("F" & LastrowE + 2).Value = cell.Offset(0, 1).Value
                        .Range("G" & LastrowE + 2).Value = cell.Offset(0, 2).Value

                    End If

                Next

            End If

        Next i

    End With

End Sub

Результаты:

enter image description here

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

В столбце E используйте формулу

=IF(B2="Log in",IF(AND(A2=A3,B3="log out"),"valid","delete"),"valid")

в E2 и опустите вниз.Затем отфильтруйте по valid или выполните цикл по столбцу E и выбросьте все, имеющие delete.

enter image description here


Расширенная версия

Обратите внимание, что этот метод не охватывает вероятность того, что другой Id X будет входить и выходить из Id A, например:

enter image description here

В этом случае тест будет более сложным:

В то время как первый метод проверки здесь не срабатывает, расширенный распознает эти случаи.

  • Столбец F: =A:A&B:B
  • Столбец G (и опускание)

    =IF(F2=A2&"Log in",IFERROR(IF(MATCH(A2&"Log out",F3:$F$1048576,0)>0,"valid"),"delete"),"valid")
    

enter image description here

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

попробуйте ниже

Предположим, что ваши данные начинаются с A2 (см. Изображение ниже)

В D2 примените приведенную ниже формулу и перетащите вниз до D9

=ЕСЛИ (ИЛИ (И (А2 = А3, В2 = «Войти», B3 = «Выйти»), И (А2 = А1, В2 = «Выйти», B1 = «Войти в систему»)), «Сохранить», "Удалить")

enter image description here

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

Возможно, это не то решение, о котором вы просите, но есть более простой способ:
Создать сводную таблицу
Добавить поля идентификаторов и статус в виде строк
Установить дату как значение и установить максимальное значение

Возможно, вам также придется форматировать даты как даты

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