返回列表 上一主題 發帖

[發問] 使用VBA跨檔案抓取多個工作表裡的資料

n7822123
　暱稱: 阿龍

中學生Rank: 2

帖子
406 
主題
8 
精華
0 
積分
453 
點名
0  
作業系統
WINDOWS 7 
軟體版本
2007 
閱讀權限
20 
性別
男 
來自
台灣 
註冊時間
2015-2-7 
最後登錄
2021-7-31 
1# 跳轉到 »
發表於 2018-9-3 02:00 | 顯示全部帖子
本帖最後由 n7822123 於 2018-9-3 02:14 編輯

回復 1# ABK

你上傳的檔案壞了，打不開!

這不難，如上一篇所說，創造字典物件

把其它工作表的編號&數量輸入進字典

再用字典查詢另一個檔案的編號，輸入字典中的數量(item)即可

先重上傳附件吧，應該不會有人那麼勤勞幫你打一大串資料的.....(程式是需要檔案測試的)

或者你先合併數個工作表再用 VLookup 函數即可!

話說你應該是生管吧!!

:D
程式是依需求寫的，需求表達不清楚
或者沒有上傳附件，愛莫能助

TOP

n7822123
　暱稱: 阿龍

中學生Rank: 2

帖子
406 
主題
8 
精華
0 
積分
453 
點名
0  
作業系統
WINDOWS 7 
軟體版本
2007 
閱讀權限
20 
性別
男 
來自
台灣 
註冊時間
2015-2-7 
最後登錄
2021-7-31 
2#
發表於 2018-9-3 22:01 | 顯示全部帖子
回復 5# ABK


   

我不確定是否是我RAR版本太舊無法打開

我可以隨便打個範例，讓你套用看看
程式是依需求寫的，需求表達不清楚
或者沒有上傳附件，愛莫能助

TOP

n7822123
　暱稱: 阿龍

中學生Rank: 2

帖子
406 
主題
8 
精華
0 
積分
453 
點名
0  
作業系統
WINDOWS 7 
軟體版本
2007 
閱讀權限
20 
性別
男 
來自
台灣 
註冊時間
2015-2-7 
最後登錄
2021-7-31 
3#
發表於 2018-9-3 23:36 | 顯示全部帖子
本帖最後由 n7822123 於 2018-9-3 23:50 編輯

回復 6# n7822123


打好了，打你的表格花了不少時間(與我想要隨便打打的初衷有點不符......)
檔案&程式碼如下，請自行套用，既然都花時間了，註解也幫你寫好(好人做到底?)
表格位置與工作表名稱已經盡量與你相同，
但是可能還是有不同的地方，請自行更改套用。
附件2個檔案放在同一路徑下執行即可(不可有其他excel檔案)
或者輸入資料的路徑&檔名讓程式去抓!

生產管理範例.rar (30.28 KB)
  1. Sub 查詢投產數量()
  2. Dim 檔名$, 路徑檔名$, tt$, R&  '宣告變數
  3. Application.ScreenUpdating = False '螢幕即時更新關閉
  4. Set Dy = CreateObject("scripting.dictionary")  '設Dy為字典物件
  5. Path = ThisWorkbook.Path  '抓取本檔案路徑
  6. Set 要填的表 = ThisWorkbook.Sheets("2018三廠機台生產追蹤") '命名此工作表為 "要填的表"
  7. '如果[G5]有資料就依[G5]路徑的檔案，如果沒就找到就找同路徑下的另一個excel檔
  8. If [G5] <> "" Then
  9.   路徑檔名 = [G5]
  10.   檔名 = Right(路徑檔名, Len(路徑檔名) - InStrRev(路徑檔名, "\"))
  11.   If Dir(路徑檔名) = "" Then MsgBox "依[G5]輸入的路徑與檔名找不到檔案，請檢查有無錯誤": Exit Sub
  12. Else
  13.   檔名 = Dir(Path & "\*.xls*")
  14.   If 檔名 = ThisWorkbook.Name Then 檔名 = Dir
  15.   路徑檔名 = Path & "\" & 檔名
  16. End If
  17. '檢查資料檔案是否已開啟
  18. For Each wb In Workbooks
  19.   If wb.Name = 檔名 Then MsgBox "資料檔案開啟中，請關閉": Exit Sub
  20. Next
  21. Set 資料檔 = Workbooks.Open(路徑檔名)  '打開資料檔案，並且命名為"資料檔"
  22. '逐一把工作表的生產代碼與頭產數量輸入到字典物件Dy裡面
  23. For Each ws In 資料檔.Sheets
  24.   ws.Activate
  25.   If ws.[D1] <> "投產數量" Then GoTo 跳過 '檢查是否為要的工作表
  26.   For R = 2 To ws.[A1].End(xlDown).Row
  27.     tt = Cells(R, 3): Dy(tt) = Cells(R, 4)
  28.   Next R
  29. 跳過:
  30. Next
  31. 要填的表.Activate '啟用要填的表
  32. '逐一把字典物件Dy裡面的值輸入到此工作表(要填的表)
  33. For R = 2 To [A1].End(xlDown).Row
  34.   tt = Cells(R, 4)
  35.   Cells(R, 5) = Dy(tt)
  36. Next R
  37. Application.DisplayAlerts = False '不跳出確認訊息
  38. '存檔關閉+釋放記憶體
  39. 資料檔.Close True: Set 資料檔 = Nothing
  40. Set Dy = Nothing
  41. Application.ScreenUpdating = True '螢幕即時更新打開
  42. End Sub
複製代碼
程式是依需求寫的，需求表達不清楚
或者沒有上傳附件，愛莫能助

TOP

n7822123
　暱稱: 阿龍

中學生Rank: 2

帖子
406 
主題
8 
精華
0 
積分
453 
點名
0  
作業系統
WINDOWS 7 
軟體版本
2007 
閱讀權限
20 
性別
男 
來自
台灣 
註冊時間
2015-2-7 
最後登錄
2021-7-31 
4#
發表於 2018-9-29 14:49 | 顯示全部帖子
本帖最後由 n7822123 於 2018-9-29 15:03 編輯

回復 17# ABK




前一段時間出差，潛水了一段時間.........
到現在時差還沒調整回來....
不過准大已幫我解決 :D


需求:
1.當資料檔無任何人開啟時， 讓主管只開啟抓資料的檔  執行抓資料程式時，資料檔會自行開啟並執行抓取資料，完成後資料檔不會自行關閉 (由主管自行手動關閉)

2.當有其他台電腦在使用資料檔時, 主管只開啟抓資料的檔  執行抓資料程式時，資料檔是以唯讀模式開啟後抓取資料，資料抓取完成後資料檔(唯讀模式)不會自行關閉 (由主管自行手動關閉)

其實只要改我原本的3行程式碼即可(若要宣告，則多一行)

宣告:
Dim read As Boolean

更改如下:
If wb.Name = 檔名 Then MsgBox "資料檔案開啟中，請關閉": Exit Sub
改為
If wb.Name = 檔名 Then read=true

Set 資料檔 = Workbooks.Open(路徑檔名)
改為
Set 資料檔 = Workbooks.Open(路徑檔名,,read)

資料檔.Close True > 此行刪除
程式是依需求寫的，需求表達不清楚
或者沒有上傳附件，愛莫能助

TOP

n7822123
　暱稱: 阿龍

中學生Rank: 2

帖子
406 
主題
8 
精華
0 
積分
453 
點名
0  
作業系統
WINDOWS 7 
軟體版本
2007 
閱讀權限
20 
性別
男 
來自
台灣 
註冊時間
2015-2-7 
最後登錄
2021-7-31 
5#
發表於 2018-9-29 17:03 | 顯示全部帖子
回復 18# n7822123


承上一樓，檔案如下
生產管理範例20180929.rar (30.48 KB)

如果心血來潮想要改為關閉資料檔案時，請啟用下一行程式碼
資料檔.Close Not read


總程式碼如下:
  1. Sub 查詢投產數量()
  2. '宣告變數
  3. Dim 檔名$, 路徑檔名$, tt$, R&
  4. Dim read As Boolean
  5. Application.ScreenUpdating = False '螢幕即時更新關閉
  6. Set Dy = CreateObject("scripting.dictionary")  '設Dy為字典物件
  7. Path = ThisWorkbook.Path  '抓取本檔案路徑
  8. '命名此工作表為 "要填的表"
  9. Set 要填的表 = ThisWorkbook.Sheets("2018三廠機台生產追蹤")
  10. '如果[G5]有資料就依[G5]路徑的檔案，如果沒到就找同路徑下的另一個excel檔
  11. If [G5] <> "" Then
  12.   路徑檔名 = [G5]
  13.   檔名 = Right(路徑檔名, Len(路徑檔名) - InStrRev(路徑檔名, "\"))
  14.   If Dir(路徑檔名) = "" Then MsgBox "依[G5]輸入的路徑與檔名找不到檔案，請檢查有無錯誤": Exit Sub
  15. Else
  16.   檔名 = Dir(Path & "\*.xls*")
  17.   If 檔名 = ThisWorkbook.Name Then 檔名 = Dir
  18.   路徑檔名 = Path & "\" & 檔名
  19. End If
  20. '檢查資料檔案是否已開啟
  21. For Each wb In Workbooks
  22.   If wb.Name = 檔名 Then read = True
  23. Next
  24. '關閉顯示訊息
  25. Application.DisplayAlerts = False
  26. '打開資料檔案，並且命名為"資料檔"
  27. Set 資料檔 = Workbooks.Open(路徑檔名, , read)
  28. '逐一把工作表的生產代碼與頭產數量輸入到字典物件Dy裡面
  29. For Each ws In 資料檔.Sheets
  30.   ws.Activate
  31.   If ws.[D1] <> "投產數量" Then GoTo 跳過 '檢查是否為要的工作表
  32.   For R = 2 To ws.[A1].End(xlDown).Row
  33.     tt = Cells(R, 3): Dy(tt) = Cells(R, 4)
  34.   Next R
  35. 跳過:
  36. Next
  37. '啟用要填的表
  38. 要填的表.Activate
  39. '逐一把字典物件Dy裡面的值輸入到此工作表(要填的表)
  40. For R = 2 To [A1].End(xlDown).Row
  41.   tt = Cells(R, 4)
  42.   Cells(R, 5) = Dy(tt)
  43. Next R
  44. '不跳出確認訊息
  45. Application.DisplayAlerts = False
  46. '如果心血來潮想要改為關閉資料檔案時，請啟用下一行程式碼
  47. '資料檔.Close Not read
  48. '存檔關閉+釋放記憶體
  49. Set 資料檔 = Nothing
  50. Set Dy = Nothing
  51. '螢幕即時更新打開
  52. Application.ScreenUpdating = True
  53. End Sub
複製代碼
程式是依需求寫的，需求表達不清楚
或者沒有上傳附件，愛莫能助

TOP

        靜思自在 : 人生沒有所有權，只有生命的使用權。
返回列表 上一主題