VBA - 从底部删除重复

问题描述：

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

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”的行为是正常，一个解决办法是找到最后一排，在任一柱A或改变的值B，删除dups然后把值返回。但是听起来好像你的最后两行是重复的，你仍然需要删除那一对中的第一个？如果是这样，您仍然可以通过在完成所有其他操作后进行检查并删除一行来完成此操作。 – 2014-12-06 01:33:21

首先，如果您有日期字段，可以先从最新到最旧排序，然后删除重复项。否则，您无法使用内置的* .RemoveDuplicates方法*来执行此操作。可以使用VBA完成，但如果您想模拟内置删除重复项的工作方式，这不会很简单。如果它只是一列或两列，并且仅基于一列（用于检查重复项），那可能很简单。 – L42 2014-12-06 05:30:14

答

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

这里是遵循循环更新的代码：

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 - 从底部删除重复

相关推荐