删除重复项并连续替换条目– 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