c_c_lai

¦^´_ 1# Michelle-W

1. Sub Ex()
   
2.     Dim rng As Range, dic As Object
   
3.     Dim r As Long
   
4.    
   
5.     r = [A2].End(xlDown).Row
   
6.     Range("$A$2:$G$" & r).RemoveDuplicates Columns:=Array(2, 4), Header:=xlYes
   
7.    
   
8.     Set dic = CreateObject("scripting.dictionary")
   
9.     For Each rng In Range("A2", [A2].End(xlDown))
   
10.         If Not dic.exists(CStr(rng.Offset(, 1).Value)) Then dic(CStr(rng.Offset(, 1).Value)) = ""
    
11.         If rng.Offset(, 3) <> "" Then dic(CStr(rng.Offset(, 1).Value)) = rng.Offset(, 3)
    
12.     Next
    
13.    
    
14.     For r = Range("A2").End(xlDown).Row To 2 Step -1
    
15.         If Cells(r, 4) <> dic(CStr(Cells(r, 2).Value)) Then Rows(r).EntireRow.Delete
    
16.     Next
    
17. End Sub

½Æ»s¥N½X

¤U¸ü (48.21 KB)

2016-7-20 20:24

   §PÂ_¨Ã§R°£.rar (16.53 KB)

¤U¸ü¦¸¼Æ: 5

2016-7-20 20:24

vinejason

¦^´_ 1# Michelle-W

§Ú³q±`¥ý¥Î¥H¤U¨ç¼Æ§ä¥X­«½Æ¸ê®Æ , µM«á¦A¿z¿ï"­«½Æ" §R°£
´£¨Ñµ¹§A°Ñ¦Ò
=IF(COUNTIF($A$2:$A$6,A2)=1,"","­«½Æ")