Hsieh

回復 1# hugh0620

1. Private Sub CommandButton1_Click()
   
2. Dim Ar()
   
3. With Application.FileDialog(msoFileDialogFolderPicker)
   
4. .Show
   
5. fd = .SelectedItems(1)
   
6. If .ButtonName = "確定" Then
   
7. fs = Dir(fd & "\*.xls")
   
8. Do Until fs = ""
   
9. fds = fd & "\" & fs
   
10. With Workbooks.Open(fds)
    
11. ReDim Preserve Ar(s)
    
12. Ar(s) = .Sheets(1).[A1].Value
    
13. s = s + 1
    
14. .Close 0
    
15. End With
    
16. fs = Dir
    
17. Loop
    
18. End If
    
19. End With
    
20. [B3].Resize(s, 1) = Application.Transpose(Ar)
    
21. End Sub

複製代碼