Question

我有一个表，其中有多个重复的ID（登录）。我需要删除重复项直到最后一次登录，如下面的示例所示。

我有下表：

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

为此，我尝试使用以下代码。问题在于它将删除重复项，但是将保留ID的第一次登录，而不是最后一个。如果我要从最后一个单元格到第一个单元格开始“ for”循环，就可以了，但是不可能（以相反的方向删除重复项）。知道我该如何解决吗？谢谢！ * ID 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

Answer 1

在E列中使用公式

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

在E2中按

并下拉。然后按valid过滤或遍历E列，并排除所有具有delete的对象。

扩展版

请注意，此方法不能涵盖另一个ID X在ID A之间登录和注销的可能性，例如：

在这种情况下，测试会更加复杂：

虽然第一种验证方法在此处失败，但扩展程序可以识别这些情况。

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")

Answer 2

也许不是您要的解决方案，但是有一种更简单的方法：
创建数据透视表
将ID和状态添加为行字段
将日期作为值，设置为显示最大

您可能还必须将日期设置为日期格式

Answer 3

尝试以下

假设您的数据以A2开头（请参见下图）

在D2中，应用以下公式并向下拖动至D9

= IF（OR（AND（A2 = A3，B2 =“ Login”，B3 =“ Logout”），AND（A2 = A1，B2 =“ Log Out”，B1 =“ Login”）），“保留”，“删除”）

Answer 4

您可以尝试：

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

结果：

VBA：根据ID删除重复的单元格

4 个答案:

扩展版