返回列表 上一主題 發帖

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

n7822123
　暱稱: 阿龍

中學生Rank: 2

帖子
406 
主題
8 
精華
0 
積分
453 
點名
0  
作業系統
WINDOWS 7 
軟體版本
2007 
閱讀權限
20 
性別
男 
來自
台灣 
註冊時間
2015-2-7 
最後登錄
2021-7-31 
1# 跳轉到 »
發表於 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
複製代碼
FileDialog-OK.rar (35.26 KB)
程式是依需求寫的，需求表達不清楚
或者沒有上傳附件，愛莫能助

TOP

n7822123
　暱稱: 阿龍

中學生Rank: 2

帖子
406 
主題
8 
精華
0 
積分
453 
點名
0  
作業系統
WINDOWS 7 
軟體版本
2007 
閱讀權限
20 
性別
男 
來自
台灣 
註冊時間
2015-2-7 
最後登錄
2021-7-31 
2#
發表於 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
複製代碼
FileDialog-OK.rar (31.72 KB)
程式是依需求寫的，需求表達不清楚
或者沒有上傳附件，愛莫能助

TOP

        靜思自在 : 【生命在呼吸間】佛陀說：「生命在呼吸間。」人無法管住自己的生命，更無法擋住死期，讓自己永住人間。既然生命去來這麼無常，我們更應該好好地愛惜它、利用它、充實它，讓這無常、寶貴的生命，散發它真善美的光輝，映照出生命真正的價值。
返回列表 上一主題