返回列表 上一主題 發帖

如何用FileDialog方式開啟資料並將其內容貼上

如何用FileDialog方式開啟資料並將其內容貼上

Dear

FileDialog.rar (32.67 KB)

有一個以上的檔案,如何利用FileDialog方式尋找檔案,並將檔案的內容Copy至Sheet(Data)內
因檔案內容第一欄標題皆一樣,所以只需Copy 一次即可

TOP

都沒有解答喔~~

TOP

回復 1# peter631114

不懂你的意思 如何是要將FileDialog路徑貼上的話 可以參考這個,
將你開啟的路徑名貼到A1儲存格:
   If fDialog.Show = -1 Then
      Range("A1").Value = fDialog.SelectedItems(1)
   End If

TOP

本帖最後由 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
複製代碼
FileDialog-OK.rar (35.26 KB)
程式是依需求寫的,需求表達不清楚
或者沒有上傳附件,愛莫能助

TOP

本帖最後由 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
複製代碼
FileDialog-OK.rar (31.72 KB)
程式是依需求寫的,需求表達不清楚
或者沒有上傳附件,愛莫能助

TOP

        靜思自在 : 【做人的開始】每一天都是故人的開始,每一個時刻都是自己的警惕。
返回列表 上一主題