12
返回列表 上一主題 發帖

請問sumif 改寫成字典或是array讓執行速度變快

Andy2483
　暱稱: 厚臉皮的學生

碩士班Rank: 5Rank: 5

帖子
1567 
主題
40 
精華
0 
積分
1591 
點名
0  
作業系統
Windows 7 
軟體版本
Excel 2010 & 2016 
閱讀權限
100 
性別
男 
來自
台灣 
註冊時間
2020-7-15 
最後登錄
2026-2-2 
1# 跳轉到 »
發表於 2022-9-14 14:40 | 顯示全部帖子
本帖最後由 Andy2483 於 2022-9-14 14:41 編輯

回復 4# s3526369


    謝謝前輩發表此主題
後學習得很多技巧
1.WorksheetFunction.SumIf的用法
2.工作表放入字典
3.陣列局部放入儲存格

後學的以下方法只節省一點點時間,供前輩參考
拋磚引玉,後學也想學厲害的前輩們的指導
  1. Sub TEST_1()
  2. Application.ScreenUpdating = False
  3. Dim X, i As Long, DA, BA, bb, BC, FY, FX, EY, QA, QB, T
  4. Dim S, Srr, Arr, Ac, xR, c, xC
  5. T = Timer
  6. Set Srr = CreateObject("Scripting.Dictionary")
  7.            '0         1        2     3       4       5
  8. S = Split("入庫明細,全機種BOM,A需求,b需求,指圖明細,倉庫庫存", ",")
  9. For i = 0 To UBound(S)
  10.    Set Srr(i) = Sheets(S(i))
  11. Next
  12. Ac = Srr(5).Cells(Rows.Count, 1).End(3).Row
  13. Arr = Range(Srr(5).[N4], Srr(5).Cells(Ac, 1))
  14. For i = 1 To Ac - 3
  15.    xR = Arr(i, 1)
  16.    Arr(i, 5) = WorksheetFunction.SumIf(Srr(0).[O:O], xR, Srr(0).[R:R]) '入庫合計
  17.    Arr(i, 3) = WorksheetFunction.SumIf(Srr(1).[P:P], xR, Srr(1).[Z:Z]) '公司總需求
  18.    Arr(i, 10) = WorksheetFunction.SumIf(Srr(2).[A:A], xR, Srr(2).[H:H]) 'A倉
  19.    Arr(i, 9) = WorksheetFunction.SumIf(Srr(3).[A:A], xR, Srr(3).[H:H]) 'B倉
  20.    Arr(i, 13) = WorksheetFunction.SumIf(Srr(4).[F:F], xR, Srr(4).[L:L]) '總出貨
  21.    QA = Arr(i, 4) + Arr(i, 5) ' ''倉庫庫存
  22.    QB = Arr(i, 11) + Arr(i, 12)
  23.    Arr(i, 8) = QA - QB - Arr(i, 10) - Arr(i, 9) - Arr(i, 13) ''公司倉
  24.    Arr(i, 7) = QA - QB - Arr(i, 13)  ''總數
  25. Next i
  26. c = Array(, 3, 5, 7, 8, 9, 10, 13)
  27. For i = 1 To UBound(c)
  28.    Srr(5).Cells(4, c(i)).Resize(UBound(Arr), 1) = Application.Index(Arr, , c(i))
  29. Next
  30. MsgBox "共耗時：" & Timer - T & " 秒"
  31. End Sub
複製代碼

TOP

Andy2483
　暱稱: 厚臉皮的學生

碩士班Rank: 5Rank: 5

帖子
1567 
主題
40 
精華
0 
積分
1591 
點名
0  
作業系統
Windows 7 
軟體版本
Excel 2010 & 2016 
閱讀權限
100 
性別
男 
來自
台灣 
註冊時間
2020-7-15 
最後登錄
2026-2-2 
2#
發表於 2022-9-15 08:37 | 顯示全部帖子
回復 7# samwang


    太快了! 強!
謝謝前輩分享!

TOP

Andy2483
　暱稱: 厚臉皮的學生

碩士班Rank: 5Rank: 5

帖子
1567 
主題
40 
精華
0 
積分
1591 
點名
0  
作業系統
Windows 7 
軟體版本
Excel 2010 & 2016 
閱讀權限
100 
性別
男 
來自
台灣 
註冊時間
2020-7-15 
最後登錄
2026-2-2 
3#
發表於 2022-9-15 14:13 | 顯示全部帖子
本帖最後由 Andy2483 於 2022-9-15 14:19 編輯

回復 4# s3526369


    謝謝前輩發表此主題
    謝謝samwang前輩指導
    謝謝准提部林前輩的 字典中的字典
後學習得很多技巧
1.字典名字參數化
2.資料倒入字典迴圈化
3..IIF 函數補 0
  1. Option Explicit
  2. Sub TEST_2()
  3. Application.ScreenUpdating = False
  4. Dim x, i, QA, QB, T, S, Srr, Arr, Ac, xR, C
  5. Dim Trr, Brr, Crr, Rs, Rqs, Rqn, Ras, Ran, B
  6. T = Timer
  7. Set Srr = CreateObject("Scripting.Dictionary")
  8. Set Trr = CreateObject("Scripting.Dictionary")
  9. S = Split("入庫明細,全機種BOM,A需求,b需求,指圖明細,倉庫庫存", ",")
  10. For i = 0 To UBound(S)
  11.    Set Srr(i) = Sheets(S(i))
  12.    Set Trr(i) = CreateObject("Scripting.Dictionary")
  13. Next
  14. Rs = Rows.Count
  15. Ac = Srr(5).Cells(Rs, 1).End(3).Row
  16. Arr = Range(Srr(5).[N4], Srr(5).Cells(Ac, 1))
  17. C = Array(15, 18, 16, 26, 1, 8, 1, 8, 6, 12)
  18. For i = 0 To UBound(C) Step 2
  19.    Set Rqs = Srr(i / 2).Cells(1, C(i))
  20.    Set Rqn = Srr(i / 2).Cells(Rs, C(i)).End(3)
  21.    Brr = Srr(i / 2).Range(Rqs, Rqn)
  22.    Set Ras = Srr(i / 2).Cells(1, C(i + 1))
  23.    Set Ran = Srr(i / 2).Cells(Rqn.Row, C(i + 1))
  24.    Crr = Srr(i / 2).Range(Ras, Ran)
  25.    For x = 1 To UBound(Brr)
  26.       B = Brr(x, 1)
  27.       Trr(i / 2)(B) = Trr(i / 2)(B) + Crr(x, 1)
  28.    Next
  29. Next
  30. For i = 1 To Ac - 3
  31.    xR = Arr(i, 1)
  32.    Arr(i, 5) = IIf(Trr(0)(xR), Trr(0)(xR), 0) '入庫合計
  33.    Arr(i, 3) = IIf(Trr(1)(xR), Trr(1)(xR), 0) '公司總需求
  34.    Arr(i, 10) = IIf(Trr(2)(xR), Trr(2)(xR), 0) 'A倉
  35.    Arr(i, 9) = IIf(Trr(3)(xR), Trr(3)(xR), 0) 'B倉
  36.    Arr(i, 13) = IIf(Trr(4)(xR), Trr(4)(xR), 0) '總出貨
  37.    QA = Arr(i, 4) + Arr(i, 5) '倉庫庫存
  38.    QB = Arr(i, 11) + Arr(i, 12)
  39.    Arr(i, 8) = QA - QB - Arr(i, 10) - Arr(i, 9) - Arr(i, 13) '公司倉
  40.    Arr(i, 7) = QA - QB - Arr(i, 13) '總數
  41. Next i
  42. C = Array(, 3, 5, 7, 8, 9, 10, 13)
  43. For i = 1 To UBound(C)
  44.    Srr(5).Cells(4, C(i)).Resize(UBound(Arr), 1) = Application.Index(Arr, , C(i))
  45. Next
  46. Set Arr = Nothing
  47. Set Brr = Nothing
  48. Set Crr = Nothing
  49. MsgBox "共耗時：" & Timer - T & " 秒"
  50. End Sub
複製代碼

TOP

Andy2483
　暱稱: 厚臉皮的學生

碩士班Rank: 5Rank: 5

帖子
1567 
主題
40 
精華
0 
積分
1591 
點名
0  
作業系統
Windows 7 
軟體版本
Excel 2010 & 2016 
閱讀權限
100 
性別
男 
來自
台灣 
註冊時間
2020-7-15 
最後登錄
2026-2-2 
4#
發表於 2022-9-15 16:45 | 顯示全部帖子
回復 12# s3526369


    請教前輩:
1.Sheets("入庫明細").Range("H2:H600") 這欄位是隱藏而且被保護了
2.Sheets("入庫明細").儲存格[H2]內容是   1501343公司倉   !跟此主題是什麼關係?
3.這 WorksheetFunction.SumIfs的值要放哪裡?

TOP

Andy2483
　暱稱: 厚臉皮的學生

碩士班Rank: 5Rank: 5

帖子
1567 
主題
40 
精華
0 
積分
1591 
點名
0  
作業系統
Windows 7 
軟體版本
Excel 2010 & 2016 
閱讀權限
100 
性別
男 
來自
台灣 
註冊時間
2020-7-15 
最後登錄
2026-2-2 
5#
發表於 2022-9-16 08:28 | 顯示全部帖子
回復 20# samwang


    前輩早安
1.事情應該不是這麼單純,多出了幾個表了!
2.WorksheetFunction.SumIfs  WorksheetFunction.SumIf 兩種都有
3.題主前輩感覺很心急!腦筋動得很快,馬上套用,又馬上出新問題! 也蠻有趣!
4.很榮幸可以在這論壇跟前輩學習,謝謝指導分享!

TOP

Andy2483
　暱稱: 厚臉皮的學生

碩士班Rank: 5Rank: 5

帖子
1567 
主題
40 
精華
0 
積分
1591 
點名
0  
作業系統
Windows 7 
軟體版本
Excel 2010 & 2016 
閱讀權限
100 
性別
男 
來自
台灣 
註冊時間
2020-7-15 
最後登錄
2026-2-2 
6#
發表於 2022-9-16 09:58 | 顯示全部帖子
回復 23# s3526369


    這段不適合前輩的新範例檔了!條件不一樣
C = Array(15, 18, 16, 26, 1, 8, 1, 8, 6, 12)  '這是O,R,P,ZA,H,A,H,F,L欄位
For i = 0 To UBound(C) Step 2   '兩兩一組去指定工作表指定欄位
   Set Rqs = Srr(i / 2).Cells(1, C(i)) 'i / 2是指定每個工作表  i=0時 Rqs是[O1]
   Set Rqn = Srr(i / 2).Cells(Rs, C(i)).End(3)
   Brr = Srr(i / 2).Range(Rqs, Rqn)
   Set Ras = Srr(i / 2).Cells(1, C(i + 1))   ' i=0時 Ras是[R1]
   Set Ran = Srr(i / 2).Cells(Rqn.Row, C(i + 1))
   Crr = Srr(i / 2).Range(Ras, Ran)
   For x = 1 To UBound(Brr)
      B = Brr(x, 1)
      Trr(i / 2)(B) = Trr(i / 2)(B) + Crr(x, 1)
   Next
Next

TOP

Andy2483
　暱稱: 厚臉皮的學生

碩士班Rank: 5Rank: 5

帖子
1567 
主題
40 
精華
0 
積分
1591 
點名
0  
作業系統
Windows 7 
軟體版本
Excel 2010 & 2016 
閱讀權限
100 
性別
男 
來自
台灣 
註冊時間
2020-7-15 
最後登錄
2026-2-2 
7#
發表於 2022-9-16 14:24 | 顯示全部帖子
回復 17# s3526369


    這範例整理了一下,並且把SumIf的 改為SumIfs 發現疑問
1.TC,TD,UC,UD這幾個變數跟執行結果是沒有關係,所以程式多跑了0.5秒
2.退庫,廢料倉 這兩個工作表也是跟執行結果是沒有關係

請教前輩:
A.是範例不完整?
B.還是要忽略上述兩項疑問!簡化如下的程式碼
C.其他
如果是A 請提供新的範例,如果是B 後學繼續以下列程式碼研習縮短執行時間,
如果是C 請再說明
  1. Sub 倉庫庫存合計COPY3()
  2. Application.ScreenUpdating = False
  3. Dim x, i As Long, DA, BA, bb, BC, FY, FX, EY, QA, QB, T
  4. Dim S, Srr, Arr, Ac, xR, C, xC
  5. T = Timer
  6. Set Srr = CreateObject("Scripting.Dictionary")
  7.            '0         1        2     3       4       5       6         7
  8. S = Split("入庫明細,全機種BOM,A需求,b需求,指圖明細,出庫明細,公司盤點,倉庫庫存", ",")
  9. For i = 0 To UBound(S)
  10.    Set Srr(i) = Sheets(S(i))
  11. Next
  12. Ac = Srr(7).Cells(Rows.Count, 1).End(3).Row
  13. Arr = Range(Srr(7).[N4], Srr(7).Cells(Ac, 1))
  14. For i = 1 To Ac - 3
  15.    xR = Arr(i, 1)
  16.    Arr(i, 5) = WorksheetFunction.SumIfs(Srr(0).[R:R], Srr(0).[O:O], xR) '入庫合計   CCCCCCC
  17.    TA = WorksheetFunction.SumIfs(Srr(0).[R:R], Srr(0).[O:O], xR, Srr(0).[S:S], "A倉")  '入庫明細-A
  18.    UA = WorksheetFunction.SumIfs(Srr(0).[R:R], Srr(0).[O:O], xR, Srr(0).[S:S], "B倉")  '入庫明細-B
  19.    Arr(i, 3) = WorksheetFunction.SumIfs(Srr(1).[Z:Z], Srr(1).[P:P], xR) '公司總需求 CCCCCCC
  20.    'TC = WorksheetFunction.SumIfs(Srr(1).[U:U], Srr(1).[P:P], xR, Srr(1).[T:T], "A倉")  '全BOM-殘單A需求
  21.    'TD = WorksheetFunction.SumIfs(Srr(1).[V:V], Srr(1).[P:P], xR, Srr(1).[T:T], "A倉")  '全BOM-訂單A需求
  22.    'UC = WorksheetFunction.SumIfs(Srr(1).[U:U], Srr(1).[P:P], xR, Srr(1).[T:T], "B倉")  '全BOM-殘單B需求
  23.    'UD = WorksheetFunction.SumIfs(Srr(1).[V:V], Srr(1).[P:P], xR, Srr(1).[T:T], "B倉")  '全BOM-訂單B需求
  24.    TE = WorksheetFunction.SumIfs(Srr(4).[L:L], Srr(4).[F:F], xR, Srr(4).[J:J], "A倉")  '指圖明細-A
  25.    UE = WorksheetFunction.SumIfs(Srr(4).[L:L], Srr(4).[F:F], xR, Srr(4).[J:J], "B倉")  '指圖明細-B
  26.    Arr(i, 13) = WorksheetFunction.SumIfs(Srr(4).[L:L], Srr(4).[F:F], xR) '指圖明細-總出貨   CCCCCC
  27.    PA = WorksheetFunction.SumIfs(Srr(4).[K:K], Srr(4).[F:F], xR) '指圖明細-廢料   CCCCCC
  28.    TB = WorksheetFunction.SumIfs(Srr(5).[R:R], Srr(5).[O:O], xR, Srr(5).[S:S], "A倉")  '出庫明細-A
  29.    UB = WorksheetFunction.SumIfs(Srr(5).[R:R], Srr(5).[O:O], xR, Srr(5).[S:S], "B倉")  '出庫明細-B
  30.    Arr(i, 11) = WorksheetFunction.SumIfs(Srr(5).[R:R], Srr(5).[O:O], xR, Srr(5).[S:S], "退庫") '出庫明細-退庫
  31.    PB = WorksheetFunction.SumIfs(Srr(5).[R:R], Srr(5).[O:O], xR, Srr(5).[S:S], "廢料倉") '出庫明細-廢料
  32.    Arr(i, 4) = WorksheetFunction.SumIfs(Srr(6).[G:G], Srr(6).[A:A], xR) '上月盤點數
  33.    TF = WorksheetFunction.SumIfs(Srr(6).[F:F], Srr(6).[A:A], xR) '公司盤點-A倉
  34.    TG = WorksheetFunction.SumIfs(Srr(6).[K:K], Srr(6).[A:A], xR) '公司盤點-調整A倉
  35.    UF = WorksheetFunction.SumIfs(Srr(6).[E:E], Srr(6).[A:A], xR) '公司盤點-B倉
  36.    UG = WorksheetFunction.SumIfs(Srr(6).[J:J], Srr(6).[A:A], xR) '公司盤點-調整B倉
  37.    Arr(i, 10) = TF + TG + TA + TB - TE 'A倉
  38.    Arr(i, 9) = UF + UG + UA + UB - UE 'B倉
  39.    Arr(i, 12) = PA + PB
  40.    XA = 0
  41.    If Arr(i, 3) > 0 Then
  42.       XA = Arr(i, 4) + Arr(i, 5) - Arr(i, 11) - Arr(i, 12) - Arr(i, 3)
  43.       If XA > 0 Then
  44.          XA = 0
  45.       End If
  46.    End If
  47.    Arr(i, 6) = XA
  48.    QA = Arr(i, 4) + Arr(i, 5) ' ''倉庫庫存
  49.    QB = Arr(i, 11) + Arr(i, 12)
  50.    Arr(i, 8) = QA - QB - Arr(i, 10) - Arr(i, 9) - Arr(i, 13) ''公司倉
  51.    Arr(i, 7) = QA - QB - Arr(i, 13)  ''總數
  52. Next i
  53. C = Array(, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13)
  54. For i = 1 To UBound(C)
  55.    Srr(7).Cells(4, C(i)).Resize(UBound(Arr), 1) = Application.Index(Arr, , C(i))
  56. Next
  57. MsgBox "共耗時：" & Timer - T & " 秒"
  58. End Sub
複製代碼

TOP

Andy2483
　暱稱: 厚臉皮的學生

碩士班Rank: 5Rank: 5

帖子
1567 
主題
40 
精華
0 
積分
1591 
點名
0  
作業系統
Windows 7 
軟體版本
Excel 2010 & 2016 
閱讀權限
100 
性別
男 
來自
台灣 
註冊時間
2020-7-15 
最後登錄
2026-2-2 
8#
發表於 2022-9-16 15:43 | 顯示全部帖子
回復 17# s3526369


    謝謝前輩提供此範例
習得 變數名參數化
以下程式碼供參考
待前輩樓上的回覆
  1. Option Explicit
  2. Sub 倉庫庫存合計COPY5()
  3. Application.ScreenUpdating = False
  4. Dim x&, i&, 值(1 To 17) As Long
  5. Dim S, Srr, Arr, Ac, xR, C, T, XA, QA, QB
  6. T = Timer
  7. Set Srr = CreateObject("Scripting.Dictionary")
  8.            '0         1        2     3       4       5       6         7
  9. S = Split("入庫明細,全機種BOM,A需求,b需求,指圖明細,出庫明細,公司盤點,倉庫庫存", ",")
  10. For i = 0 To UBound(S)
  11.    Set Srr(i) = Sheets(S(i))
  12. Next
  13. Ac = Srr(7).Cells(Rows.Count, 1).End(3).Row
  14. Arr = Range(Srr(7).[N4], Srr(7).Cells(Ac, 1))
  15. For i = 1 To Ac - 3
  16.    xR = Arr(i, 1)
  17.    值(1) = WorksheetFunction.SumIfs(Srr(0).[R:R], Srr(0).[O:O], xR) '入庫合計C
  18.    值(2) = WorksheetFunction.SumIfs(Srr(0).[R:R], Srr(0).[O:O], xR, Srr(0).[S:S], "A倉") '入庫明細-A
  19.    值(3) = WorksheetFunction.SumIfs(Srr(0).[R:R], Srr(0).[O:O], xR, Srr(0).[S:S], "B倉") '入庫明細-B
  20.    值(4) = WorksheetFunction.SumIfs(Srr(1).[Z:Z], Srr(1).[P:P], xR) '公司總需求C
  21.    值(5) = WorksheetFunction.SumIfs(Srr(4).[L:L], Srr(4).[F:F], xR, Srr(4).[J:J], "A倉") '指圖明細-A
  22.    值(6) = WorksheetFunction.SumIfs(Srr(4).[L:L], Srr(4).[F:F], xR, Srr(4).[J:J], "B倉") '指圖明細-B
  23.    值(7) = WorksheetFunction.SumIfs(Srr(4).[L:L], Srr(4).[F:F], xR) '指圖明細-總出貨C
  24.    值(8) = WorksheetFunction.SumIfs(Srr(4).[K:K], Srr(4).[F:F], xR) '指圖明細-廢料C
  25.    值(9) = WorksheetFunction.SumIfs(Srr(5).[R:R], Srr(5).[O:O], xR, Srr(5).[S:S], "A倉") '出庫明細-A
  26.    值(10) = WorksheetFunction.SumIfs(Srr(5).[R:R], Srr(5).[O:O], xR, Srr(5).[S:S], "B倉") '出庫明細-B
  27.    值(11) = WorksheetFunction.SumIfs(Srr(5).[R:R], Srr(5).[O:O], xR, Srr(5).[S:S], "退庫") '出庫明細-退庫
  28.    值(12) = WorksheetFunction.SumIfs(Srr(5).[R:R], Srr(5).[O:O], xR, Srr(5).[S:S], "廢料倉") '出庫明細-廢料
  29.    值(13) = WorksheetFunction.SumIfs(Srr(6).[G:G], Srr(6).[A:A], xR) '上月盤點數
  30.    值(14) = WorksheetFunction.SumIfs(Srr(6).[F:F], Srr(6).[A:A], xR) '公司盤點-A倉
  31.    值(15) = WorksheetFunction.SumIfs(Srr(6).[K:K], Srr(6).[A:A], xR) '公司盤點-調整A倉
  32.    值(16) = WorksheetFunction.SumIfs(Srr(6).[E:E], Srr(6).[A:A], xR) '公司盤點-B倉
  33.    值(17) = WorksheetFunction.SumIfs(Srr(6).[J:J], Srr(6).[A:A], xR) '公司盤點-調整B倉
  34.    Arr(i, 5) = 值(1)
  35.    Arr(i, 3) = 值(4)
  36.    Arr(i, 13) = 值(7)
  37.    Arr(i, 11) = 值(11)
  38.    Arr(i, 4) = 值(13)
  39.    Arr(i, 10) = 值(14) + 值(15) + 值(2) + 值(9) - 值(5) 'A倉
  40.    Arr(i, 9) = 值(16) + 值(17) + 值(3) + 值(10) - 值(6) 'B倉
  41.    Arr(i, 12) = 值(8) + 值(12)
  42.    XA = 0
  43.    If 值(4) > 0 Then
  44.       XA = 值(13) + 值(1) - 值(11) - Arr(i, 12) - 值(4)
  45.       If XA > 0 Then
  46.          XA = 0
  47.       End If
  48.    End If
  49.    Arr(i, 6) = XA
  50.    QA = 值(13) + 值(1) '倉庫庫存
  51.    QB = 值(11) + Arr(i, 12)
  52.    Arr(i, 8) = QA - QB - Arr(i, 10) - Arr(i, 9) - 值(7) '公司倉
  53.    Arr(i, 7) = QA - QB - 值(7)  '總數
  54. Next i
  55. C = Array(, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13)
  56. For i = 1 To UBound(C)
  57.    Srr(7).Cells(4, C(i)).Resize(UBound(Arr), 1) = Application.Index(Arr, , C(i))
  58. Next
  59. MsgBox "共耗時：" & Timer - T & " 秒"
  60. End Sub
複製代碼

TOP

Andy2483
　暱稱: 厚臉皮的學生

碩士班Rank: 5Rank: 5

帖子
1567 
主題
40 
精華
0 
積分
1591 
點名
0  
作業系統
Windows 7 
軟體版本
Excel 2010 & 2016 
閱讀權限
100 
性別
男 
來自
台灣 
註冊時間
2020-7-15 
最後登錄
2026-2-2 
9#
發表於 2022-9-17 09:56 | 顯示全部帖子
太厲害了!
33# 祥龍十八掌
34# 打通任督二脈

TOP

Andy2483
　暱稱: 厚臉皮的學生

碩士班Rank: 5Rank: 5

帖子
1567 
主題
40 
精華
0 
積分
1591 
點名
0  
作業系統
Windows 7 
軟體版本
Excel 2010 & 2016 
閱讀權限
100 
性別
男 
來自
台灣 
註冊時間
2020-7-15 
最後登錄
2026-2-2 
10#
發表於 2022-9-17 16:48 | 顯示全部帖子
回復 33# s3526369


    提醒前輩
下方紅字處須改為2

Sub 倉庫庫存()
Dim Arr, xD, xD1, xD2, xD3, xD4, xD5, xD6, xD7, T$, i&, QA, QB
Set xD = CreateObject("Scripting.Dictionary")   '入庫合計
Set xD1 = CreateObject("Scripting.Dictionary")  '公司總需求
Set xD2 = CreateObject("Scripting.Dictionary")  'A倉
Set xD3 = CreateObject("Scripting.Dictionary")  'B倉
Set xD4 = CreateObject("Scripting.Dictionary")  '總出貨
Set xD5 = CreateObject("Scripting.Dictionary")  '盤點數'
Set xD6 = CreateObject("Scripting.Dictionary") '退庫
Set xD7 = CreateObject("Scripting.Dictionary")  '廢料
TM = Timer
With Sheets("入庫明細")
    Arr = .Range(.[r1], .[o65536].End(3))
    For i = 2 To UBound(Arr)
        T = Arr(i, 1): xD(T) = xD(T) + Arr(i, 4) '入庫合計
    Next
End With
With Sheets("全機種BOM")
    Arr = .Range(.[Z1], .[p65536].End(3))
    For i = 2 To UBound(Arr)
        T = Arr(i, 1): xD1(T) = xD1(T) + Arr(i, 11) '公司總需求
    Next
End With
With Sheets("A需求")
    Arr = .Range(.[h1], .[A65536].End(3))
    For i = 4 To UBound(Arr)
        T = Arr(i, 1): xD2(T) = xD2(T) + Arr(i, 8)  'A倉
    Next
End With
With Sheets("B需求")
    Arr = .Range(.[h1], .[A65536].End(3))
    For i = 4 To UBound(Arr)
        T = Arr(i, 1): xD3(T) = xD3(T) + Arr(i, 8)  'B倉
    Next
End With
With Sheets("指圖明細")
    Arr = .Range(.[L1], .[f65536].End(3))
    For i = 4 To UBound(Arr)
        T = Arr(i, 1): xD4(T) = xD4(T) + Arr(i, 7)  '總出貨
    Next
End With
With Sheets("公司盤點")
    Arr = .Range(.[G1], .[A65536].End(3))
    For i = 4 To UBound(Arr)
        T = Arr(i, 1): xD5(T) = xD5(T) + Arr(i, 7)  '公司盤點
    Next
End With

With Sheets("退庫")
    Arr = .Range(.[C1], .[A65536].End(3))
    For i = 3 To UBound(Arr)
        T = Arr(i, 1): xD6(T) = xD6(T) + Arr(i, 3)  'B倉
    Next
End With
With Sheets("廢料倉")
    Arr = .Range(.[C1], .[A65536].End(3))
    For i = 3 To UBound(Arr)
        T = Arr(i, 1): xD7(T) = xD7(T) + Arr(i, 3)  'B倉
    Next
End With

With Sheets("倉庫庫存")
    Arr = .Range(.[m3], .[A65536].End(3))
    For i = 2 To UBound(Arr)
        T = Arr(i, 1)
        QA = xD5(T) + xD(T) ' ''倉庫庫存
        QB = xD6(T) + xD7(T)
        Arr(i, 5) = xD(T)    '入庫合計
        Arr(i, 13) = xD4(T)  '總出貨
        Arr(i, 3) = xD1(T)   '總需求
        Arr(i, 8) = QA - QB - xD2(T) - xD3(T) - xD4(T)  '公司倉
        Arr(i, 9) = xD3(T)   'B倉
        Arr(i, 10) = xD2(T)  'A倉
        Arr(i, 7) = QA - QB - xD4(T)  '總數
        Arr(i, 4) = xD5(T)
        Arr(i, 11) = xD6(T)
        Arr(i, 12) = xD7(T)
        
        If Arr(i, 3) > 0 Then
        XA = xD5(T) + xD(T) - xD6(T) - xD7(T) - Arr(i, 3)
            If XA >= 0 Then XA = "0"
        Else
            XA = "0"
        End If
        If xD(T) = 0 Then Arr(i, 5) = "0"
        If xD5(T) = 0 Then Arr(i, 4) = "0"
        If xD1(T) = 0 Then Arr(i, 3) = "0"
        If xD4(T) = 0 Then Arr(i, 13) = "0"
   Arr(i, 6) = XA
    Next
    .[a3].Resize(UBound(Arr), 13) = Arr
End With
'MsgBox "共耗時：" & Timer - TM & " 秒"
End Sub

TOP

        靜思自在 : 站在半路，比走到目標更辛苦。
12
返回列表 上一主題