excel - 如果第一列和第二列中的术语在下面重复但保留一个，则删除整行

Question

我目前有一个我认为我无法解决的问题。我有一个 Excel 表格，其中包含多个标题，例如“Promoter”、“Account”、“#order”、“Date”和“City”，其中包含数千行。我只想知道是否有 VBA 代码可以删除具有重复值的特定行，如果这些行出现在 2 列（A 和 B）中，例如“帐户”和“发起人”在许多其他行中是否相同，我只想删除重复项并留下一个用于会计目的。

例子：

数据

0987:Raymond:ORD-27:NY

1256:Hannah :ORD-99:MI

1345:André  :ORD-45:WI

1866:Darryl :ORD-02:WA

6419:John.  :ORD-22:CA

0987:Raymond:ORD-87:MN

0987:Raymond:ORD-24:CO

Result:

1256:Hannah :ORD-99:MI

1345:André  :ORD-45:WI

1866:Darryl :ORD-02:WA

6419:John.  :ORD-22:CA

0987:Raymond:ORD-87:MN

因为“帐户”（09087）和“发起人”（Raymond）在下面的行中重复，即使顺序和状态不同，我只想删除属于该类别的重复项（相同的帐户和发起人）并保留一个，因为订单属于同一个帐户。有几个“发起人”需要考虑，这就是为什么我不知道如何进行。

非常感谢您的帮助，我将感谢您的每一个回答。

标签： excelvba

Answer 1

保持唯一（两列）

• 调整常量部分中的值。

编码

Option Explicit

Sub keepUniqueTwoColumns()
    
    Const wsName As String = "Sheet1"
    Const First As Long = 2
    Const ColLR As String = "A"
    Const Col1 As String = "A"
    Const Col2 As String = "B"
    Const Delimiter As String = "|"
    
    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    
    Dim ws As Worksheet: Set ws = wb.Worksheets(wsName)
    
    Dim Last As Long: Last = ws.Cells(ws.Rows.Count, ColLR).End(xlUp).Row
    Dim rg1 As Range: Set rg1 = ws.Cells(First, Col1).Resize(Last - First + 1)
    Dim rg2 As Range: Set rg2 = ws.Cells(First, Col2).Resize(Last - First + 1)
    
    Dim dict As Object: Set dict = CreateObject("Scripting.Dictionary")
    
    Dim drg As Range
    Dim cel As Range
    Dim Key As Variant
    Dim i As Long
    
    For Each cel In rg1.Cells
        i = i + 1
        Key = rg1.Cells(i) & Delimiter & rg2.Cells(i)
        If dict.Exists(Key) Then
            If drg Is Nothing Then
                Set drg = rg1.Cells(i)
            Else
                Set drg = Union(drg, rg1.Cells(i))
            End If
        Else
            dict.Add Key, Empty
        End If
    Next cel
    Set dict = Nothing
    
    If drg Is Nothing Then
        MsgBox "Nothing deleted.", vbExclamation, "Fail"
    Else
        Dim dCount As Long: dCount = drg.Cells.Count
        drg.EntireRow.Delete
        MsgBox "Deleted rows: " & dCount, vbInformation, "Success"
    End If
    
End Sub