Question

简而言之，对于这个项目，我想删除重复项，保留最新的重复项，并在第一行的行中替换这些最新项。请按照下面给出的示例进行进一步的了解：

我希望通过保留A到C列中的最新条目来删除基于ID号的重复项。此外，我想保留D列和E列中每个条目的第一行中的每个单元格。最终，这意味着最新的条目将被替换为第一个条目的A，B和C列。

重要说明：D和E列仅填充在每个ID的第一项中。具有相同ID的所有其他行将始终在D和E列中包含空单元格。

请参阅下表以更清楚地了解表中的内容：

基于上面给出的示例，这意味着：

根据ID从A到C列删除重复项并保留每个ID的最新条目（从A到C列：删除第1、2、3、5和6行中的内容，并保留每个ID的最新条目在这种情况下是第4行和第7行）
保留每个ID的第一个条目的D和E列（请注意，每个ID的只有第一个条目将是非空单元格。在此示例中，有两个ID，分别为123和458 D＆E列的第1行和第2行将为非空）
用A列到C列中的先前条目行中的最新条目替换最新条目（从A列到C列，分别将第1行和第2行替换为第4行和第7行）

换句话说：在不将列D修改为E的情况下，将A列更新为C列

请参阅以下带有指示的相同表格：

我尝试了两种不同的代码，但都没有给我想要的最终结果。

因此，我最初的代码如下。它仅保留先前的条目，并保留最初的A到E列：

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

最终结果不准确，因为它将第一个条目保留在A到C列中：

上面的代码中的问题是它不会将名称和日期更改为最新的条目（分别是Bob，第6周和Peter，第4周）

我做的下一个代码是保留最新的条目，但是不幸的是，这会将我在D列中的条目删除为E：

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:$E$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

以下是我从第二个代码获得的结果：

上面的代码可以完美地用最新的条目替换我的第一个条目，但是它将删除D＆E列中的所有内容（注释和附加com）。我想知道是否可以通过仅替换特定列中的重复项而不是删除整个行来修改我的代码（这显然是此代码中的问题）。

我希望这些解释足够清楚，可以帮助您解决这个问题。请记住，我有成千上万的行，针对我给出的示例的量身定制的解决方案并不是我想要的。我愿意接受任何建议，谢谢您的帮助！

Answer 1

此例程使用字典对象删除重复项。

要保留重复项的最后一行，我们从底部开始，一直向上。

如果确实有重复项，我们将测试以查看第4列或第5列中是否有任何内容，如果存在，我们会覆盖字典中的内容（请注意，数组项不能直接更改，但是必须提取数组，对其进行更改，然后放回原处。

然后，我们创建一个结果数组并将其写回到工作表中。

明智地选择wsRes，wsSrc和rRes将使您可以将结果保存在单独的工作表中，甚至覆盖原始数据（尽管我不建议这样做审计目的）。

请注意，您必须按照代码注释中的说明设置参考，或使用后期绑定。

Option Explicit
'Set reference to Microsoft Scripting Runtime or
'    use late-binding
Sub deDup()
    Dim wsSrc As Worksheet, wsRes As Worksheet, rRes As Range
    Dim vSrc As Variant, vRes As Variant
    Dim vRow(2 To 5) As Variant, vKey As Variant, vTemp As Variant
    Dim I  As Long, J As Long
    Dim D As Dictionary

 Set wsSrc = Worksheets("sheet3")
 Set wsRes = Worksheets("Sheet3")
    Set rRes = wsRes.Cells(1, 9)

With wsSrc
    vSrc = .Range(.Cells(1, 1), .Cells(.Rows.Count, 1).End(xlUp)).Resize(columnsize:=5)
End With

Set D = New Dictionary
For I = UBound(vSrc, 1) To 2 Step -1
    vKey = vSrc(I, 1)
    If Not D.Exists(vKey) Then
        For J = 2 To 5
            vRow(J) = vSrc(I, J)
        Next J
        D.Add Key:=vKey, Item:=vRow
    Else
        If vSrc(I, 4) <> "" Or vSrc(I, 5) <> "" Then
            vTemp = D(vKey)
            vTemp(4) = vSrc(I, 4)
            vTemp(5) = vSrc(I, 5)
            D(vKey) = vTemp
        End If
    End If
Next I

ReDim vRes(0 To D.Count, 1 To 5)

    'Headers
    For J = 1 To 5
        vRes(0, J) = vSrc(1, J)
    Next J

    'Data
    I = 0
    For Each vKey In D.Keys
        I = I + 1
        vRes(I, 1) = vKey
        For J = 2 To 5
            vRes(I, J) = D(vKey)(J)
        Next J
    Next vKey

Set rRes = rRes.Resize(rowsize:=D.Count + 1, columnsize:=UBound(vRes, 2))
With rRes
    .EntireColumn.Clear
    .Value = vRes
    With .Rows(1)
        .Font.Bold = True
        .HorizontalAlignment = xlCenter
    End With
    .EntireColumn.AutoFit
End With
End Sub

Answer 2

我的数据如下（A列ID，B列名称，C列数据）

<section class="work">
  <div class="content-wrap">
    <h2>Work Experience</h2>
    <!-- Job Details: copy this block to add more positions. -->
    <div class="column-narrow">
      <h3>Marketing & Social Media Manager</h3>
      <p class="uppercase">Beauty9</p>
      <p>September 2018 - Present</p>
    </div>
    <div class="column-wide job-description">
      <p>........</p>
    </div>
  </div>
</section>

如果获得唯一ID并将其放在一列中，请使用VBA或公式。

然后，您可以在VBA中使用A B C 1 a Last 1 a 2 b pre 2 b 3 c test 3 c test2 3 c 3 c从数据中获取最后一个值，就像这样

evaluate

其中F列是唯一的ID号。

这假定数据是按时间顺序排列的。

将第一个重复项中的第一个重复项替换为最后一个重复项– Excel VBA

2 个答案: