删除重复项并连续替换条目 – Excel VBA

Question

在这个项目中，我希望通过保留最新条目来根据 ID 号删除重复项。此外，我想保留 D 列中的每个单元格，并从以前的条目开始。这最终意味着最新条目将被替换为先前条目的行。请参阅下表以获得更清晰的信息：

基于上面给出的示例，我正在寻找的结果是：

• 根据 ID 从 A 到 C 列删除重复项并保留最新条目
• 保留之前条目中的 D 到 H 列
• 用之前条目行中的最新条目替换之前的条目。

换句话说：在不修改 D 列到 H 的情况下更新 A 列到 C 列

所以，我的初始代码如下。它只保留以前的条目并保留 D 到 H 列：

Sub Delete_Duplicates()
Sheet5.Range("$A$1:$H$29999").RemoveDuplicates Columns:=Array(1) _
    , Header:=xlYes
End Sub

下表显示了我将获得的结果：

我做的下一个代码是保留最新的条目，但这会删除我在 D 到 H 列中的条目：

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

下表显示了我将获得的结果：

我愿意接受任何建议，感谢您的帮助！

Answer 1

试试这个解决方案 - 因为您实际上是在使用日期列中的字符串，所以我们必须拆分数字并测试它是否大于或小于另一周的数字：

Option Explicit
Sub Delete_Duplicates()

    Dim i As Long, j As Long
    Dim id As String, weeknum As Long

    For i = Cells(Rows.Count, 1).End(xlUp).Row To 2 Step -1
        id = Cells(i, 1).Value
        weeknum = Split(Cells(i, 3).Value, " ")(1)

        For j = i - 1 To 2 Step -1
            If Cells(j, 1).Value = id Then
                If Split(Cells(j, 3).Value, " ")(1) < weeknum Then
                    Rows(j).Delete
                    i = i - 1
                Else
                    Rows(i).Delete
                    Exit For
                End If
            End If
        Next j
    Next i

End Sub