2014-12-06 55 views
0

我正在運行一個循環來將註釋添加到運行列表的末尾。我在刪除基於列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列留下最底部的註釋?

感謝您的幫助!

+0

因爲「RemoveDuplicates」的行爲是正常,一個解決辦法是找到最後一排,在任一柱A或改變的值B,刪除dups然後把值返回。但是聽起來好像你的最後兩行是重複的,你仍然需要刪除那一對中的第一個?如果是這樣,您仍然可以通過在完成所有其他操作後進行檢查並刪除一行來完成此操作。 – 2014-12-06 01:33:21

+1

首先,如果您有日期字段,可以先從最新到最舊排序,然後刪除重複項。否則,您無法使用內置的* .RemoveDuplicates方法*來執行此操作。可以使用VBA完成,但如果您想模擬內置刪除重複項的工作方式,這不會很簡單。如果它只是一列或兩列,並且僅基於一列(用於檢查重複項),那可能很簡單。 – L42 2014-12-06 05:30:14

回答

0

我添加了一段代碼,它在左側插入一列,並添加了跟蹤註釋順序的行號。然後我按降序排列,以便最早的評論進入列表底部。然後我刪除重複項並重新排序列表並刪除數字列。

這裏是遵循循環更新的代碼:

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