Board logo

標題: [發問] 使用VBA跨檔案抓取多個工作表裡的資料 [打印本頁]
作者: ABK    時間: 2018-9-2 18:13     標題: 使用VBA跨檔案抓取多個工作表裡的資料

本帖最後由 ABK 於 2018-9-2 18:16 編輯

請教各位大大:

我要在第一個Excel的工作表上 抓取第二個Excel檔案裡多個不同工作表裡面的資料，
第一個檔"三廠生產日報" 放在C:/Users/Golden/Desktop/
第二個檔"三廠各機生產紀錄" 放在D:/生產日報/

生產代碼是唯一的，不會重複。
想用VBA讓第一個檔"三廠生產日報"以 生產代碼 搜尋 第二個檔"三廠各機生產紀錄" A1、A2、A3、B1、B2、C1、C2 工作表裡相同生產代碼的 投產數量 紀錄到第一個檔"三廠生產日報"裡。
作者: faye59    時間: 2018-9-2 22:14

回復 1# ABK


    相信以你的程度應該這樣回就看得懂了。
論壇內有相關範例可以用。
Open Excel Workbook，
  1. Set Wb = Workbooks.Open("\\Test\B.xlsx")
複製代碼
開啟第二個Excel方式範例
CreateObject("Scripting.Dictionary")建立字典比對回傳結果。
類似範例可以參考#3
先試著寫寫看，有問題再幫忙修改。

然而我覺得用Access建立索引更快，用Excel巨集稍慢些。
作者: n7822123    時間: 2018-9-3 02:00

本帖最後由 n7822123 於 2018-9-3 02:14 編輯

回復 1# ABK

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

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

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

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

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

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

話說你應該是生管吧!!

:D
作者: ABK    時間: 2018-9-3 21:44

回復 2# faye59


    謝謝faye59大!
  我研究一下您提供的方法!
作者: ABK    時間: 2018-9-3 21:45

本帖最後由 ABK 於 2018-9-3 21:52 編輯

回復 3# n7822123

謝謝 n7822123大
我把檔案分開壓縮試試看 !
我是在產線工作，產線產出後各機台共用一張Excel表，由各機台負責人Key入產出資料， 主管要看的是部分的匯總資料。
作者: n7822123    時間: 2018-9-3 22:01

回復 5# ABK


    [attach]29329[/attach]

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

我可以隨便打個範例，讓你套用看看
作者: n7822123    時間: 2018-9-3 23:36

本帖最後由 n7822123 於 2018-9-3 23:50 編輯

回復 6# n7822123


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

[attach]29333[/attach]
  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
複製代碼
作者: ABK    時間: 2018-9-4 02:25

本帖最後由 ABK 於 2018-9-4 02:27 編輯

回復 7# n7822123


    感謝阿龍大的熱心回復!  讓你費這麼多時間 !  真是抱歉!
    我來拜讀研究一下 !   感謝!  感謝!
作者: ABK    時間: 2018-9-10 23:58

回復 8# ABK


再請教一下各位前輩!
當我使用阿龍大的範例抓取資料時， Excel 會要求我關閉被抓取資料那個檔才能抓取資料，
有辦法做到不關閉資料檔也可以抓取資料嗎?
作者: 准提部林    時間: 2018-9-11 09:49

'檢查資料檔案是否已開啟, 若未開啟則以[唯讀]開啟, 並以uChk標示為1
On Error Resume Next
uChk = 0: Set 資料檔 = Workbooks(檔名)
On Error GoTo 0
If 資料檔 Is Nothing Then uChk = 1: Set 資料檔 = Workbooks.Open(路徑檔名, ReadOnly:=True)


'關閉檔案_不存檔 (若資料檔不是程式所開啟, 則不關閉)
If uChk = 1 Then 資料檔.Close 0
作者: 准提部林    時間: 2018-9-11 09:52

若要抓的檔案只有一個,
最好強制在G5指定[路徑及檔名], 以避免誤抓~~
也省去多餘的程式碼~~
作者: 准提部林    時間: 2018-9-11 10:16

本帖最後由 准提部林 於 2018-9-11 10:19 編輯

生產日報表中的〔機台/日期/生產代碼〕, 是事先輸入的?
須三個都符合才抓〔投產數量〕？？
作者: ABK    時間: 2018-9-13 12:06

回復 10# 准提部林

謝謝准提大

這兩個檔案實際使用情形是:
1. 資料檔(生產紀錄) 和 要抓資料的檔(生產日報)是存放在同一個資料夾裡並開放共用。
2. 資料檔是產線一直開著， 一但有產出就由產線即時輸入產出資料，其他電腦只能用唯讀模式開啟   這個檔案。
3. 抓資料的檔是主管在另外一台電腦開啟使用的。


我將准提大的碼 置入阿龍大程式碼的這個位置，
如果資料檔和抓資料的檔在同一台電腦同時開著，可以抓取資料且資料檔不會關閉。
但若是 資料檔是關閉時， 執行抓資料程式就會出現錯誤訊息。


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

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


以下是准提大的程式碼置入阿龍大的程式碼:
  1. Sub 查詢投產數量()

  3. '宣告變數
  4. Dim 檔名$, 路徑檔名$, tt$, R&

  6. Application.ScreenUpdating = False '螢幕即時更新關閉

  8. Set Dy = CreateObject("scripting.dictionary")  '設Dy為字典物件
  9. Path = ThisWorkbook.Path  '抓取本檔案路徑

  11. '命名此工作表為 "要填的表"
  12. Set 要填的表 = ThisWorkbook.Sheets("2018三廠機台生產追蹤")

  14. '如果[G5]有資料就依[G5]路徑的檔案，如果沒到就找同路徑下的另一個excel檔
  15. If [G5] <> "" Then
  16.   路徑檔名 = [G5]
  17.   檔名 = Right(路徑檔名, Len(路徑檔名) - InStrRev(路徑檔名, "\"))
  18.   If Dir(路徑檔名) = "" Then MsgBox "依[G5]輸入的路徑與檔名找不到檔案，請檢查有無錯誤": Exit Sub
  19. Else
  20.   檔名 = Dir(Path & "\*.xls*")
  21.   If 檔名 = ThisWorkbook.Name Then 檔名 = Dir
  22.   路徑檔名 = Path & "\" & 檔名
  23. End If
  24.   
  25. '檢查資料檔案是否已開啟
  26. For Each wb In Workbooks
  27.   'If wb.Name = 檔名 Then MsgBox "資料檔案開啟中，請關閉": Exit Sub
  28.   
  29.   
  30. '檢查資料檔案是否已開啟, 若未開啟則以[唯讀]開啟, 並以uChk標示為1
  31. On Error Resume Next
  32. uChk = 0: Set 資料檔 = Workbooks(檔名)
  33. On Error GoTo 0
  34. If 資料檔 Is Nothing Then uChk = 1: Set 資料檔 = Workbooks.Open(路徑檔名, ReadOnly:=True)
  35. '關閉檔案_不存檔 (若資料檔不是程式所開啟, 則不關閉)
  36. If uChk = 1 Then 資料檔.Close 0

  38. Next

  40. '打開資料檔案，並且命名為"資料檔"
  41. Set 資料檔 = Workbooks.Open(路徑檔名)

  43. '逐一把工作表的生產代碼與頭產數量輸入到字典物件Dy裡面
  44. For Each ws In 資料檔.Sheets
  45.   ws.Activate
  46.   If ws.[D1] <> "投產數量" Then GoTo 跳過 '檢查是否為要的工作表
  47.   For R = 2 To ws.[A1].End(xlDown).Row
  48.     tt = Cells(R, 3): Dy(tt) = Cells(R, 4)
  49.   Next R
  50. 跳過:
  51. Next

  53. '啟用要填的表
  54. 要填的表.Activate

  56. '逐一把字典物件Dy裡面的值輸入到此工作表(要填的表)
  57. For R = 2 To [A1].End(xlDown).Row
  58.   tt = Cells(R, 4)
  59.   Cells(R, 5) = Dy(tt)
  60. Next R

  62. '不跳出確認訊息
  63. Application.DisplayAlerts = False

  65. '存檔關閉+釋放記憶體
  66. '資料檔.Close True: Set 資料檔 = Nothing
  67. 'Set Dy = Nothing

  69. '螢幕即時更新打開
  70. Application.ScreenUpdating = True
  71. End Sub
複製代碼
作者: 准提部林    時間: 2018-9-13 12:17

回復 13# ABK

12樓的問題還是沒有說明,
抓資料的依據是什麼??
根據事先輸入的條件抓? 還是有資料全抓進來?
上次的抓檔資料要不要清除?
作者: ABK    時間: 2018-9-13 13:17

回復 14# 准提部林

謝謝准堤大

1. 廠別/機台/日期/生產代碼 都是事先輸入
2. 只依據生產代碼 抓投產數量
3. 上次抓檔資料要清除 (產線有可能修正Key錯的資料，重新抓一次比較保險)

※ 生產代碼是唯一的， 不會重複。
作者: 准提部林    時間: 2018-9-13 16:25

[attach]29393[/attach]

xN = xN & ".xls"  記得改成 xN = xN & ".xlsx"
作者: ABK    時間: 2018-9-14 07:21

回復 16# 准提部林


    謝謝准堤大 !
   我來好好研究一下!   感恩!  感恩!
作者: n7822123    時間: 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 > 此行刪除
作者: n7822123    時間: 2018-9-29 17:03

回復 18# n7822123


承上一樓，檔案如下
[attach]29469[/attach]

如果心血來潮想要改為關閉資料檔案時，請啟用下一行程式碼
資料檔.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
複製代碼




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