Hsieh

¦^´_ 3# s7659109

1. Sub Import_Data()
   
2. Dim Sh As Worksheet, A As Range, Ar(), Ay(0 To 7), s&, Sn$, cnt#, cnt1#
   
3. Sn = InputBox("¿é¤J¬d¸ß³f¸¹", , "001")
   
4. For Each Sh In Sheets
   
5. If Sh.Name Like "A*" Then
   
6.    With Sh
   
7.       For Each A In .Range("B:B").SpecialCells(xlCellTypeConstants)
   
8.         If A = Sn Then
   
9.             For i = -1 To 6
   
10.                Ay(i + 1) = A.Offset(, i)
    
11.             Next
    
12.            ReDim Preserve Ar(s)
    
13.            Ar(s) = Ay
    
14.            cnt = cnt + Ay(4)
    
15.            cnt1 = cnt1 + Ay(7)
    
16.            s = s + 1
    
17.         End If
    
18.       Next
    
19.     End With
    
20. End If
    
21. Next
    
22. With Sheet4
    
23. .UsedRange.Offset(2) = ""
    
24. If s > 0 Then
    
25. ReDim Preserve Ar(s)
    
26. Ar(s) = Array("¦X­p", "", "", "", cnt, "", "", cnt1)
    
27. s = s + 1
    
28. .Columns("B:B").NumberFormat = "@"
    
29. .[A3].Resize(s, 8) = Application.Transpose(Application.Transpose(Ar))
    
30. Else
    
31. MsgBox "µL²Å¦X¸ê®Æ"
    
32. End If
    
33. End With
    
34. End Sub

½Æ»s¥N½X

Hsieh

¦^´_ 5# s7659109

1. Sub ex()
   
2. Dim Sn$, Fs, F, Ar()
   
3. Sn = InputBox("½Ð¿é¤J¬d¸ß³f¸¹", , "001")
   
4. Fs = Application.GetOpenFilename("Excel Files(*.xls),*.xls", , "½Ð¿ï¾ÜÀÉ®×(¥i½Æ¿ï)", , True)
   
5. If Not IsArray(Fs) Then MsgBox "½Ð¿ï¾ÜÀÉ®×": Exit Sub
   
6. For Each F In Fs
   
7.    With Workbooks.Open(F)
   
8.       With .Sheets(1)
   
9.          For Each a In .Range("B:B").SpecialCells(xlCellTypeConstants)
   
10.             If a = Sn Then
    
11.                ay = a.Offset(, -1).Resize(, 8).Value
    
12.                ReDim Preserve Ar(s)
    
13.                Ar(s) = ay
    
14.                s = s + 1
    
15.             End If
    
16.          Next
    
17.       End With
    
18.       .Close 0
    
19.     End With
    
20. Next
    
21. With ThisWorkbook.Sheets("Á`ªí")
    
22. .UsedRange.Offset(2) = ""
    
23. If s > 0 Then
    
24.   .[A1] = Sn
    
25.   .[A3].Resize(s, 8) = Application.Transpose(Application.Transpose(Ar))
    
26.   Else
    
27.   MsgBox "¨S¦³²Å¦X¸ê®Æ"
    
28. End If
    
29. End With
    
30. End Sub

½Æ»s¥N½X