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

Question

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

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

设置类似这样：（抱歉格式化）

  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 列的重复项，因此将删除所有车道 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

之后