VBA - 从底部删除重复项答案

【问题标题】：VBA - Remove duplicates from bottomVBA - 从底部删除重复项
【发布时间】：2015-02-04 06:40:57
【问题描述】：

我正在运行一个循环以将注释添加到运行列表的末尾。我在根据第 1 列中的标识符删除重复项时遇到问题。如果两列中的重复项完全相同，则以下代码有效。

Sub Note_update()
Dim ws As Worksheet
Dim notes_ws As Worksheet
Dim row
Dim lastrow
Dim notes_nextrow

'find the worksheet called notes
For Each ws In Worksheets
    If ws.Name = "Notes" Then
        Set notes_ws = ws
    End If
Next ws

'get the nextrow to print to
notes_nextrow = notes_ws.Range("A" & Rows.Count).End(xlUp).row + 1

'loop through other worksheets
For Each ws In Worksheets
    'ignore the notes worksheet
    If ws.Name <> "Notes" And ws.Index > Sheets("Master").Index Then
        'find lastrow
        lastrow = ws.Range("L" & Rows.Count).End(xlUp).row
        For row = 2 To lastrow
            'if the cell is not empty
            If ws.Range("L" & row) <> "" Then
                notes_ws.Range("B" & notes_nextrow).Value = ws.Range("L" & row).Value
                notes_ws.Range("A" & notes_nextrow).Value = ws.Range("F" & row).Value
                notes_nextrow = notes_nextrow + 1
            End If
        Next row
    End If
Next ws

notes_ws.Range("A:B").RemoveDuplicates Columns:=Array(1, 2), Header:=xlYes

End Sub

如果我更改以下代码的最后一行，它将仅根据第一列中的标识符删除重复项。

notes_ws.Range("A:B").RemoveDuplicates Columns:=Array(1, 1), Header:=xlYes

问题是它从列表底部删除了重复项，但底部是我想保留的最新注释。

问题：如何删除重复项并仅根据第 1 列留下最底部的注释？

感谢您的帮助！

【问题讨论】：

由于“RemoveDuplicates”的行为正常，一种解决方案是找到最后一行，更改 Col A 或 B 中的值，删除 dups 然后将值放回原处。但听起来如果你的最后两行是重复的，你还需要删除那对中的第一行吗？如果是这样，您仍然可以通过在所有其他操作完成后检查并删除一行来做到这一点。
首先，如果您有一个日期字段，您可以先从最新到最旧对其进行排序，然后删除重复项。否则，您无法使用内置的 .RemoveDuplicates 方法 执行此操作。可以使用 VBA 完成，但如果您想模拟内置删除重复项的工作方式，这并不简单。如果它只有一列或两列并且仅基于一列（用于检查重复项），那可能很容易。

标签： excel vba loops duplicates

【解决方案1】：

我添加了一段额外的代码，它在左侧插入一列并添加行号，它跟踪 cmets 的顺序。然后我按降序排序，以便最旧的 cmets 排在列表的底部。然后我删除了重复项并重新排序列表并删除了数字列。

下面是循环之后的更新代码：

Columns("A:A").EntireColumn.Insert
For i = 1 To notes_nextrow
    ThisWorkbook.ActiveSheet.Range("A" & i).Formula = "=row()"
Next i
Columns("A:A").Copy
Columns("A:A").PasteSpecial (xlPasteValues)

Range("A:C").Sort key1:=Range("A:A"), order1:=xlDescending, Header:=xlYes
notes_ws.Range("A:C").RemoveDuplicates Columns:=2, Header:=xlYes
Range("A:C").Sort key1:=Range("A:A"), order1:=xlAscending, Header:=xlYes
Columns("A:A").Delete
Range("a1").Select

【讨论】：