Hsieh

¦^´_ 1# yuch8663

1. Sub Ex()
   
2. Dim Sh As Worksheet, Ar(), A As Range, B As Range, C As Range, s&, i%
   
3. Set d = CreateObject("Scripting.Dictionary")
   
4. Set d1 = CreateObject("Scripting.Dictionary")
   
5. For Each Sh In Sheets(Array("Sheet1", "Sheet2", "Sheet3", "Sheet4"))
   
6. With Sh
   
7. Set C = IIf(i = 0 Or i = 2, .[A1], .[C1])
   
8.    For Each A In .Range(C, .[IV1].End(xlToLeft))
   
9.        ReDim Preserve Ar(s)
   
10.        Ar(s) = A.Value
    
11.        s = s + 1
    
12.        For Each B In .Range(A.Offset(1, 0), .Cells(65536, A.Column).End(xlUp))
    
13.           If i = 0 Then
    
14.              d1(.Cells(B.Row, 1) & .Cells(B.Row, 2)) = Array(.Cells(B.Row, 1), .Cells(B.Row, 2))
    
15.              d(.Cells(B.Row, 1) & .Cells(B.Row, 2) & A) = B.Value
    
16.              ElseIf d1.exists(.Cells(B.Row, 1) & .Cells(B.Row, 2)) = True Then
    
17.              d(.Cells(B.Row, 1) & .Cells(B.Row, 2) & A) = B.Value
    
18.           End If
    
19.        Next
    
20.     Next
    
21.     i = i + 1
    
22. End With
    
23. Next
    
24. With Sheet5
    
25. .Cells = ""
    
26. .[A1].Resize(, s) = Ar
    
27. r = d1.Count
    
28. .[A2].Resize(d1.Count, 2) = Application.Transpose(Application.Transpose(d1.items))
    
29. For Each C In .Range(.[C1], .[IV1].End(xlToLeft))
    
30.    For Each A In C.Offset(1, 0).Resize(d1.Count, 1)
    
31.       A = d(.Cells(A.Row, 1) & .Cells(A.Row, 2) & C)
    
32.    Next
    
33. Next
    
34. End With
    
35. End Sub

½Æ»s¥N½X

Hsieh

¦^´_ 4# yuch8663


1.¤é´ÁÄæ¦ì­«½Æ¥u»Ý§ï³o¦æ
Set C = IIf(i = 0, .[A1], .[C1])
2.¦]¬°SHEET1¸òSHEET4ªºeqÄæ¦W­«½Æ¥u»Ý±N¨ä¤¤¤@Äæ§ó¦W§Y¥i