vba - 使用基于两列的 VBA 删除重复项 - Excel 2003

Question

我正在使用具有下表的 Excel 2003，并希望根据名字和姓氏删除重复的行(如果它们相同)。

-------------------------------------
| first name | last name | balance  | 
-------------------------------------
| Alex       | Joe       | 200      |
| Alex       | Joe       | 200      |
| Dan        | Jac       | 500      |
-------------------------------------

到目前为止，我有一个 VB 宏，只有在名字重复时才删除重复项。

    Sub DeleteDups() 

    Dim x               As Long 
    Dim LastRow         As Long 

    LastRow = Range("A65536").End(xlUp).Row 
    For x = LastRow To 1 Step -1 
        If Application.WorksheetFunction.CountIf(Range("A1:A" & x), Range("A" & x).Text) > 1 Then 
            Range("A" & x).EntireRow.Delete 
        End If 
    Next x 

End Sub 

并请告知是否可以在文件打开后运行此宏。提前致谢

Answer 1

您可以使用字典来存储值。字典中已经存在的任何值也可以在迭代期间删除。

代码:

Sub RemoveDuplicates()

    Dim NameDict As Object
    Dim RngFirst As Range, CellFirst As Range
    Dim FName As String, LName As String, FullName As String
    Dim LRow As Long

    Set NameDict = CreateObject("Scripting.Dictionary")
    With Sheet1 'Modify as necessary.
        LRow = .Range("A" & .Rows.Count).End(xlUp).Row
        Set RngFirst = .Range("A2:A" & LRow)
    End With

    With NameDict
        For Each CellFirst In RngFirst
            With CellFirst
                FName = .Value
                LName = .Offset(0, 1).Value
                FullName = FName & LName
            End With
            If Not .Exists(FullName) And Len(FullName) > 0 Then
                .Add FullName, Empty
            Else
                CellFirst.EntireRow.Delete
            End If
        Next
    End With

End Sub

截图:

运行前:



运行后:



您可以调用 Workbook_Open每次打开工作簿时触发它的事件。

让我们知道这是否有帮助。