Question

我有一个宏，它根据另一个电子表格中的原始数据填充电子表格。

每行的主要排序方法是按行（Origin到目的地）。每个泳道的结果进一步按周排序。我需要删除每个泳道的重复周数，同时保留最后的结果。

设置类似于:(抱歉格式化）

  A         B
LANE A  WEEK 38
LANE A  WEEK 39
LANE A  WEEK 40
LANE A  WEEK 41
LANE A  WEEK 42
LANE A  WEEK 39
LANE A  WEEK 40
LANE A  WEEK 41
LANE A  WEEK 42
LANE A  WEEK 39
LANE B  WEEK 38
LANE B  WEEK 39
LANE B  WEEK 40

我发现以下代码适用于单个通道

Dim Rng As Range, Dn As Range, n As Long
Dim Lst As Long, nRng As Range
Lst = Range("B" & Rows.Count).End(xlUp).Row
    With CreateObject("scripting.dictionary")
        .CompareMode = vbTextCompare
For n = Lst To 1 Step -1
    If Not .Exists(Range("B" & n).Value) Then
        .Add Range("B" & n).Value, Nothing
    Else
        If nRng Is Nothing Then
            Set nRng = Range("B" & n)
        Else
            Set nRng = Union(nRng, Range("B" & n))
        End If
End If
Next n
If Not nRng Is Nothing Then nRng.EntireRow.Delete
End With

但由于它只删除基于星期或B列的重复项，因此所有Lane B都被删除。

编辑：

最终结果应该如下所示

 A         B
LANE A  WEEK 38
LANE A  WEEK 39
LANE A  WEEK 40
LANE A  WEEK 41
LANE A  WEEK 42


LANE B  WEEK 38
LANE B  WEEK 39
LANE B  WEEK 40

这是一组示例数据的屏幕截图

https://imgur.com/a/MU6vB

在第5行，有ATL6泳道的重复数据。之后是CMH1。我需要删除同一车道内的重复周，保留对车道的最后更新。正如我的代码目前所见，它只关注本周。因此，所有ATL6数据都被删除，只剩下CMH1。

对于ATL6泳道，我需要保留6-9行，并删除2-5作为重复。这将需要适用于所有情况，而不仅仅是这些行。

Answer 1

注意

我刚刚意识到如果只有两个，只会工作   重复集。如果可以有更多，那么让我知道，我   将删除

我使用下面的代码和这个示例数据（基于您的示例数据结构）并且它有效。它利用了Excel的内置功能，但如果您的数据集巨大，性能可能会受到影响。

<强>之前

Option Explicit

Sub RemoveEarliestDupes()

    Dim ws1 As Worksheet
    Set ws1 = Worksheets("Sheet1")

    With ws1

        Dim LastRow As Long
        LastRow = .Cells(.Rows.Count, 1).End(xlUp).Row

        .Range("D" & LastRow).FormulaArray = "=IF(ISNUMBER(MATCH(A" & LastRow & "&B" & LastRow & ",$A$1:A" & LastRow - 1 & "&$B$1:$B$" & LastRow - 1 & ",0)),"""",""Remove"")"
        .Range("D" & LastRow).Copy

        With .Range(.Range("D2"), .Range("D" & LastRow - 1))
            .PasteSpecial xlPasteFormulas
            .Calculate
        End With

        With .Range(.Range("D2"), .Range("D" & LastRow))
            .Copy
            .PasteSpecial xlPasteValues
            .AutoFilter 1, "Remove"
            .SpecialCells(xlCellTypeVisible).EntireRow.Delete
            .ClearContents
        End With

        .AutoFilterMode = False

    End With

End Sub

<强>后

删除重复项，同时保留2列之间的最后一行

1 个答案: