資料比對與刪除

modelcrazyer

各位達人
我有三個工作表,分別為
工作表1
A-1
B-2
C-3
工作表2
A-1
D-3
E-5
G-6
工作表3
B-2
F-7
H-9
D-10
想做到經工作表1經與工作表2及工作表3比對後只剩下
A-1
B-2
請問該怎麼做

kimbal

1. Sub test()
   
2.     Set ld = CreateObject("Scripting.Dictionary")
   
3.     For Each sht In Array(Worksheets("工作表2"), Worksheets("工作表3"))
   
4.         For Each c In Range(sht.Range("A1"), sht.Range("A1").End(xlDown))
   
5.             If Not ld.exists(c.Value) Then
   
6.                 ld.Add c.Value, c.Value
   
7.             End If
   
8.         Next
   
9.     Next
   
10.     With Worksheets("工作表1")
    
11.         For i = .Range("A1").End(xlDown).Row To 1 Step -1
    
12.             If ld.exists(.Range("A1").Offset(i - 1, 0).Value) Then
    
13.                 .Range("A1").Offset(i - 1, 0).Delete (xlShiftUp)
    
14.             End If
    
15.         Next
    
16.     End With
    
17.     Set ld = Nothing
    
18. End Sub

複製代碼

c_c_lai

回復 1# modelcrazyer
回復 2# kimbal

1. If ld.exists(.Range("A1").Offset(i - 1, 0).Value) Then

複製代碼

應改正為

1. If Not ld.exists(.Range("A1").Offset(i - 1, 0).Value) Then

複製代碼

答案才會如 #1 modelcrazyer 樓主所述。

GBKEE

回復 3# c_c_lai
也可以這樣寫

1. Option Explicit
   
2. Sub Ex()
   
3.     Dim i, Rng As Range, Msg As Boolean, Sht As Variant
   
4.      With Worksheets("工作表1")
   
5.         For i = .Range("A1").End(xlDown).Row To 1 Step -1
   
6.             Msg = False
   
7.             For Each Sht In Array(Worksheets("工作表2"), Worksheets("工作表3"))
   
8.                 Set Rng = Sht.Range(Sht.Range("A1"), Sht.Range("A1").End(xlDown))
   
9.                 If Not IsError(Application.Match(.Cells(i, "A"), Rng, 0)) Then Msg = True
   
10.             Next
    
11.             If Msg = False Then .Range("a" & i).Delete xlUp
    
12.         Next
    
13.     End With
    
14. End Sub

複製代碼

c_c_lai

回復 4# GBKEE
這種單刀直入的撰寫方式，也比較直接了當，
這亦是我平時程式的撰寫風格，謝謝您！