Board logo

標題: 如何用FileDialog方式開啟資料並將其內容貼上 [打印本頁]
作者: peter631114    時間: 2019-12-24 12:18     標題: 如何用FileDialog方式開啟資料並將其內容貼上

Dear
作者: peter631114    時間: 2019-12-24 12:19

有一個以上的檔案,如何利用FileDialog方式尋找檔案,並將檔案的內容Copy至Sheet(Data)內
因檔案內容第一欄標題皆一樣,所以只需Copy 一次即可
作者: peter631114    時間: 2019-12-30 15:41

都沒有解答喔~~
作者: hayden0009    時間: 2020-4-8 10:59

回復 1# peter631114

不懂你的意思 如何是要將FileDialog路徑貼上的話 可以參考這個，
將你開啟的路徑名貼到A1儲存格：
   If fDialog.Show = -1 Then
      Range("A1").Value = fDialog.SelectedItems(1)
   End If
作者: n7822123    時間: 2020-4-9 13:01

本帖最後由 n7822123 於 2020-4-9 13:05 編輯

回復 3# peter631114

試試看，懶的寫註解了，有問題再問
  1. Sub 選檔貼上()
  2. Dim ExFile()
  3. Application.ScreenUpdating = False
  4. With Application.FileDialog(msoFileDialogFilePicker)
  5.   .Filters.Clear
  6.   .Filters.Add "Excel檔案", "*.xls*"
  7.   .InitialFileName = ThisWorkbook.Path
  8.   .AllowMultiSelect = True
  9.   If .Show = 0 Then Exit Sub
  10.   ReDim ExFile(1 To .SelectedItems.Count)
  11.   For Each FN In .SelectedItems: n% = n% + 1: ExFile(n) = FN: Next
  12. End With
  13. Set 此表 = ActiveSheet: Set Data表 = Sheets("Data")
  14. For Each FN In ExFile
  15.   With Workbooks.Open(FN).Sheets(1): Data表.Activate
  16.     If [A1] = "" Then
  17.       .[A1].CurrentRegion.Copy [A1]
  18.     Else
  19.       .[A1].CurrentRegion.Offset(1).Copy [A1].End(4).Offset(1)
  20.     End If
  21.     .Parent.Close False
  22.   End With
  23. Next
  24. Data表.Columns.AutoFit
  25. Set 此表 = Nothing: Set Data表 = Nothing: Erase ExFile
  26. End Sub
複製代碼
[attach]31906[/attach]
作者: n7822123    時間: 2020-4-9 13:51

本帖最後由 n7822123 於 2020-4-9 13:54 編輯

回復 5# n7822123

寫簡短一點，並回到按鈕頁(像是什麼都沒發生)

  1. Sub 選檔貼上()
  2. Application.ScreenUpdating = False
  3. Set 此表 = ActiveSheet: Set Data表 = Sheets("Data")
  4. With Application.FileDialog(msoFileDialogFilePicker)
  5.   .Filters.Clear
  6.   .Filters.Add "Excel檔案", "*.xls*"
  7.   .InitialFileName = ThisWorkbook.Path
  8.   .AllowMultiSelect = True
  9.   If .Show = 0 Then Exit Sub
  10.   For Each FN In .SelectedItems
  11.     With Workbooks.Open(FN).Sheets(1): Data表.Activate
  12.       If [A1] = "" Then
  13.         .[A1].CurrentRegion.Copy [A1]
  14.       Else
  15.         .[A1].CurrentRegion.Offset(1).Copy [A1].End(4).Offset(1)
  16.       End If
  17.       .Parent.Close False
  18.     End With
  19.   Next
  20. End With
  21. Data表.Columns.AutoFit: 此表.Activate
  22. Set 此表 = Nothing: Set Data表 = Nothing
複製代碼
[attach]31908[/attach]



歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)