Hsieh

¦^´_ 1# luke

1. Sub ex()
   
2. Dim Ar(), A As Range, C As Range, B As Range
   
3. Set d = CreateObject("Scripting.Dictionary")
   
4. With sheet2
   
5. For Each A In .Range(.[D2], .[D2].End(xlDown))
   
6.    x = A & A.Offset(, 1)
   
7.    For Each C In .Range(.[F1], .[F1].End(xlToRight))
   
8.    d(x & C) = .Cells(A.Row, C.Column)
   
9.    Next
   
10. Next
    
11. End With
    
12. With sheet1
    
13. For Each A In .Range(.[A1], .[A1].End(xlDown))
    
14. Set B = A.Resize(, 4)
    
15. p = IIf(d(B(1) & B(2) & B(3)) = "", Replace(B(2), "X", ""), d(B(1) & B(2) & B(3)))
    
16. n = IIf(d(B(1) & B(2) & B(4)) = "", Replace(B(2), "X", ""), d(B(1) & B(2) & B(4)))
    
17. A.Offset(, 5).Resize(, 4) = Array(B(1), B(2), p, n)
    
18. Next
    
19. End With
    
20. End Sub

½Æ»s¥N½X