- 帖子
- 1446
- 主題
- 40
- 精華
- 0
- 積分
- 1470
- 點名
- 0
- 作業系統
- Windows 7
- 軟體版本
- Excel 2010 & 2016
- 閱讀權限
- 50
- 性別
- 男
- 來自
- 台灣
- 註冊時間
- 2020-7-15
- 最後登錄
- 2024-11-28
|
13#
發表於 2022-9-15 14:13
| 只看該作者
本帖最後由 Andy2483 於 2022-9-15 14:19 編輯
回復 4# s3526369
謝謝前輩發表此主題
謝謝samwang前輩指導
謝謝准提部林前輩的 字典中的字典
後學習得很多技巧
1.字典名字參數化
2.資料倒入字典迴圈化
3..IIF 函數補 0- Option Explicit
- Sub TEST_2()
- Application.ScreenUpdating = False
- Dim x, i, QA, QB, T, S, Srr, Arr, Ac, xR, C
- Dim Trr, Brr, Crr, Rs, Rqs, Rqn, Ras, Ran, B
- T = Timer
- Set Srr = CreateObject("Scripting.Dictionary")
- Set Trr = CreateObject("Scripting.Dictionary")
- S = Split("入庫明細,全機種BOM,A需求,b需求,指圖明細,倉庫庫存", ",")
- For i = 0 To UBound(S)
- Set Srr(i) = Sheets(S(i))
- Set Trr(i) = CreateObject("Scripting.Dictionary")
- Next
- Rs = Rows.Count
- Ac = Srr(5).Cells(Rs, 1).End(3).Row
- Arr = Range(Srr(5).[N4], Srr(5).Cells(Ac, 1))
- C = Array(15, 18, 16, 26, 1, 8, 1, 8, 6, 12)
- For i = 0 To UBound(C) Step 2
- Set Rqs = Srr(i / 2).Cells(1, C(i))
- 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))
- 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
- For i = 1 To Ac - 3
- xR = Arr(i, 1)
- Arr(i, 5) = IIf(Trr(0)(xR), Trr(0)(xR), 0) '入庫合計
- Arr(i, 3) = IIf(Trr(1)(xR), Trr(1)(xR), 0) '公司總需求
- Arr(i, 10) = IIf(Trr(2)(xR), Trr(2)(xR), 0) 'A倉
- Arr(i, 9) = IIf(Trr(3)(xR), Trr(3)(xR), 0) 'B倉
- Arr(i, 13) = IIf(Trr(4)(xR), Trr(4)(xR), 0) '總出貨
- QA = Arr(i, 4) + Arr(i, 5) '倉庫庫存
- QB = Arr(i, 11) + Arr(i, 12)
- Arr(i, 8) = QA - QB - Arr(i, 10) - Arr(i, 9) - Arr(i, 13) '公司倉
- Arr(i, 7) = QA - QB - Arr(i, 13) '總數
- Next i
- C = Array(, 3, 5, 7, 8, 9, 10, 13)
- For i = 1 To UBound(C)
- Srr(5).Cells(4, C(i)).Resize(UBound(Arr), 1) = Application.Index(Arr, , C(i))
- Next
- Set Arr = Nothing
- Set Brr = Nothing
- Set Crr = Nothing
- MsgBox "共耗時：" & Timer - T & " 秒"
- End Sub
|
|
