Hsieh

¦^´_ 1# luke

1. Sub ¿z¿ï()
   
2. Set d = CreateObject("Scripting.Dictionary")
   
3. With sheet1
   
4.    For Each a In .Range(.[B1], .Cells(.Rows.Count, 2).End(xlUp))
   
5.       If a.Interior.ColorIndex = 6 Then d(a.Value) = Array(a, a.Offset(, 1), a)
   
6.    Next
   
7.    With .Range("L1")
   
8.       .CurrentRegion = ""
   
9.       .Resize(d.Count, 3) = Application.Transpose(Application.Transpose(d.items))
   
10.       .Resize(d.Count, 3).Sort .Cells(1, 1), xlAscending, Header:=xlNo
    
11.    End With
    
12. End With
    
13. End Sub
    
14. Sub ¨ú¥N()
    
15. Set d = CreateObject("Scripting.Dictionary")
    
16. Set d1 = CreateObject("Scripting.Dictionary")
    
17. With sheet1
    
18.    With .Range("L1").CurrentRegion
    
19.    For Each a In .Columns(1).Cells
    
20.       d(a.Value) = a.Offset(, 2)
    
21.       d1(a.Offset(, 2).Value) = a.Value
    
22.    Next
    
23.    End With
    
24.    For Each a In .Range(.[B1], .Cells(.Rows.Count, 2).End(xlUp))
    
25.      If d1.exists(a.Value) And a.Interior.ColorIndex <> 6 Then MsgBox "¸ê®Æ­«½Æ": Exit Sub
    
26.    Next
    
27.    For Each a In .Range(.[B1], .Cells(.Rows.Count, 2).End(xlUp))
    
28.      If d.exists(a.Value) And a.Interior.ColorIndex = 6 Then a.Value = d(a.Value)
    
29.    Next
    
30.    MsgBox "¨ú¥N§¹¦¨"
    
31. End With
    
32. End Sub

½Æ»s¥N½X