Board logo

標題: [發問] 兩個Excel 表 跑巨集到報表上 [打印本頁]
作者: v03586    時間: 2015-9-23 22:16     標題: 兩個Excel 表 跑巨集到報表上

我有設計兩個Excel 用來收集作業人員收料與作業進度計錄用的表單

我想要結合兩個Excel  加入判斷式 帶入報表中當中有要加入判斷式，不知道如何撰寫

[attach]22068[/attach]

基板接收(Substrate Receiving)上面的Database資料表，要比對報表上的MONBR欄位
如果資料表[Substrate Receiving]上的MO欄位 等於 報表上的  MONBR 欄位
則在收料欄上 打勾，沒有就保持空白 ，如例圖
[attach]22070[/attach]


電漿清洗(Plasma System) 上面的Database資料表，B欄與E欄要比對報表上的MONBR欄位
如果資料表[Plasma System]上的B欄位 等於 報表上的  MONBR 欄位
則在狀態欄上顯示P   (表示Substrate站作業完畢要送入Plasma站)
[attach]22071[/attach]

如果資料表上E欄位等於 報表上MONBR欄位
則在狀態顯示 V (打勾表示完成 Substrate站與Plasma站)

我在想辦斷式應該要 如果B欄位不等於E 欄位 則顯示P  
如果B欄位 等於 E 欄位 則顯示 V  應該是這樣程式判斷式才不會打結吧?

請問以上如何寫在Excel 巨集內，如果可以可否另開一個Excel 執行巨集 將這Substrate Receiving、Plasma System 資料表 跑巨集在 報表範例上?
[attach]22072[/attach]
作者: v03586    時間: 2015-9-23 22:22

報表範例是經事先跑過前輩的巨集產生出來的報表(資料上千筆)，這邊舉例幾筆....
所以巨集應該不能寫在報表範例上，前輩們的報表是將公司制定的報表 另外寫一個EXCEL跑巨集成這份
但因為裡面程式碼太複雜不想跟前輩的混在一起，則希望另外寫一個
作者: 准提部林    時間: 2015-9-24 11:39

本帖最後由 准提部林 於 2015-9-24 11:45 編輯

在〔輸入表〕輸入完成後，再派出結果至〔報表〕，
做了幾個防呆，參考看看：
  1. Sub 派出結果()
  2. Dim Arr, A, T$, xD, DT As Range
  3. Set DT = [H22]
  4. Set xD = CreateObject("Scripting.Dictionary")
  5. Arr = Range([Database!B2], [Database!B65536].End(xlUp)(2))
  6. For Each A In Arr
  7. 　　T = Right(A, 7): If T Like "#######" Then xD(T) = 1
  8. Next
  9. If xD.Count = 0 Then MsgBox "Database無資料可作業！": Exit Sub
  10. 　
  11. Dim FL$, xB As Workbook, xS As Worksheet, R&
  12. FL = ThisWorkbook.Path & "\範例報表.xls"
  13. If Dir(FL) = "" Then MsgBox "找不到報表檔！": Exit Sub
  14. If CheckBookOpen(FL) > 0 Then
  15. 　　MsgBox "報表檔正被開啟中，為避免錯誤，請先關閉！": Exit Sub
  16. End If
  17. 　
  18. Set xB = Workbooks.Open(FL)
  19. With xB.Sheets(1)
  20. 　　R = .[B65536].End(xlUp).Row
  21. 　　If R < 7 Then MsgBox "報表無 MONBR 資料！": Exit Sub
  22. 　　Arr = .Range("B7:B" & R)
  23. 　　For i = 1 To UBound(Arr)
  24. 　　　　T = Right(Arr(i, 1), 7): Arr(i, 1) = ""
  25. 　　　　If xD(T) = 1 Then Arr(i, 1) = "V"
  26. 　　Next i
  27. 　　With .Range("N7:N" & R): .Value = Arr: .Select: End With
  28. End With
  29. 　
  30. DT(2) = DT: DT = Now
  31. MsgBox "派出結果至報表已完成，確定無誤後儲存再關閉檔案！":
  32. End Sub
  33. 　
  34. '＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
  35. Private Function CheckBookOpen(BookName$) As Long　'副程式-檢查檔案是否開啟中
  36. On Error Resume Next
  37. Open BookName For Binary Access Write Lock Write As #1
  38. Close #1
  39. CheckBookOpen = Err.Number
  40. On Error GoTo 0
  41. End Function
複製代碼
附件下載：
[attach]22082[/attach]
作者: v03586    時間: 2015-9-24 20:26

回復 3# 准提部林


    Dear 板大
礙於權限關係  檔案暫不能下載
  但板大貼出來的程式碼中是可以執行的!!!感謝板大的support
  想問檔案中  第二個功能分析 是否可行 (因為目前無法下載 看不到 Sorry)
作者: 准提部林    時間: 2015-9-24 21:45

回復 4# v03586


用這下載吧：
http://www.funp.net/573395

多加點油，無法下載附件很不方便，不好意思老用其它的下載空間，得顧慮論壇的運作！
作者: v03586    時間: 2015-9-24 22:19

回復 5# 准提部林


    感謝版大，已下載OK...真不好意思 麻煩你了!!!
我會多加努力的:)



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