删除重复项，同时保持最后一行在两列之间

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列的重复项目，所有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 

后