2014-12-06 3 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를 삭제 한 다음 값을 다시 입력하십시오. 그러나 마지막 두 행이 중복 된 것처럼 보이면 여전히 그 쌍 중 첫 번째 행을 삭제해야합니까? 그렇다면, 다른 모든 작업이 끝난 후에 확인하고 한 행을 삭제하면됩니다. –

+1

첫째, 날짜 필드가있는 경우 먼저 가장 최근 날짜 순으로 정렬 한 다음 중복 항목을 제거 할 수 있습니다. 그렇지 않으면 내장 된 * .RemoveDuplicates 메소드 *를 사용하여 수행 할 수 없습니다. VBA를 사용하여 수행 할 수 있지만 기본 제공 제거 중복 작동 방식을 에뮬레이션하려면 간단하지 않습니다. 그것이 단지 하나 또는 두 개의 열이고 전적으로 하나의 열을 기반으로하는 경우 (중복 검사 용) 쉽지 않을 수 있습니다. – L42

답변

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 
관련 문제