Question

我正在运行一个循环来将注释添加到正在运行的列表的末尾。我在删除基于第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列？

感谢您的帮助！

Answer 1

我添加了一段代码，在左边插入一列，并添加行号，跟踪注释的顺序。然后我按降序排序，以便最旧的评论到达列表的底部。然后我删除了重复项并重新排序列表并删除了数字列。

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

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

VBA - 从底部删除重复项

1 个答案: