Hsieh

¦^´_ 3# amu1129
¦bBOOK1¸òBOOK2ªºSheet1¼Ò²Õ¤º¿é¤Jµ{¦¡½X
§ïÅÜBOOK1¸òBOOK2ªºSheet1ªºb2Àx¦s®æ¸Õ¸Õ

1. Private Sub Worksheet_Change(ByVal Target As Range)
   
2. Dim Ar(), Ay(), A As Range
   
3. Ky = Array("B01", "B02", "A01", "A02")
   
4. If Target.Address <> "$B$2" Then Exit Sub
   
5. fs = ThisWorkbook.Path & "\5 B01,B02,A01,A02.xls"
   
6. ReDim Preserve Ay(k)
   
7. Ay(k) = Array("", "¤Ø¤o", "½s¸¹", "¼Æ¶q")
   
8. k = k + 1
   
9. With Workbooks.Open(fs)
   
10.    With .Sheets(1)
    
11.      For Each A In .Range(.[B4], .[B65536].End(xlUp))
    
12.         If A = Target Then
    
13.            ReDim Preserve Ar(s)
    
14.            Ar(s) = Array(A.Offset(, 4).Value, A.Offset(, 1).Value, A.Offset(, 5).Value)
    
15.            cnt = cnt + A.Offset(, 5).Value
    
16.            s = s + 1
    
17.         End If
    
18.     Next
    
19.    End With
    
20.    .Close 0
    
21. End With
    
22. For i = 0 To 3
    
23.    For j = 0 To UBound(Ar)
    
24.       If Ar(j)(0) = Ky(i) Then
    
25.          ReDim Preserve Ay(k)
    
26.          Ay(k) = Array(k, Ar(j)(0), Ar(j)(1), Ar(j)(2))
    
27.          k = k + 1
    
28.       End If
    
29.    Next
    
30. Next
    
31. ReDim Preserve Ay(k)
    
32. Ay(k) = Array("", "¦X­p", "", cnt)
    
33. k = k + 1
    
34. With Me
    
35.    .[A3:D65536].Clear
    
36.    .[A4].Resize(k, 4).Value = Application.Transpose(Application.Transpose(Ay))
    
37.    .Range("A2").Resize(k + 2, 4).Borders.LineStyle = 1
    
38.    .Range("A2").Resize(k + 2, 4).Borders.Weight = xlThin
    
39.    .Range("B2").Resize(k + 2, 3).BorderAround 1, xlThick, xlColorIndexAutomatic
    
40. End With
    
41. End Sub

½Æ»s¥N½X