刪除重複項，同時保持最後一行在兩列之間

我有一個宏，它基於另一電子表格中的原始數據填充電子表格。刪除重複項，同時保持最後一行在兩列之間

每行的主要排序方法是按車道（起點到終點）。每個車道的結果按周進一步分類。我需要在保留最後結果的同時刪除每個車道的重複周。

的設置與此類似：（抱歉格式）

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刪除爲重複項。這需要適用於所有情況，而不僅僅是針對這些行。

來源

2017-10-20 Stuka

予以明確。什麼是最終結果？（請更新原始問題）。例如，在您的樣本日期中，A車道將有兩行：第38周和第39周或僅第39周？ –

更新，重申更新。電子表格（每天更新）的每次更新將爲每個通道添加4個條目。這些是在一年中的幾周內，在4周的點差。因此，當前工作表的每個車道的週數爲39-42（約15左右）。所以預期的結果將有4周a車道，4周b車道等等。這將每天更新一個無限期，所以週數會隨着時間的推移而增長 – Stuka

爲什麼不使用「數據」選項卡下的排序功能，然後刪除B列中的重複項？使用宏記錄 – Maldred

注意

我才意識到這將只有工作，如果有整整兩個複製組。如果有可能還不止這些，然後讓我知道，我會刪除

我用下面的代碼與此樣本數據（根據您的樣本數據結構）和它的工作。它利用了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

後

來源

2017-10-20 19:53:50

感謝Scott，但是有可能會有相對大量的重複項目，但是性能不是太大的問題。我曾嘗試並運行該代碼，修剪爲2個副本，但在.ClearContents上發生了對象錯誤，並且工作表的內容被完全刪除了 – Stuka

，您可以刪除該行。這不是必需的。 –

刪除重複項，同時保持最後一行在兩列之間

回答

相關問題