- 帖子
- 46
- 主題
- 3
- 精華
- 0
- 積分
- 73
- 點名
- 0
- 作業系統
- WIN7
- 軟體版本
- Office 2007
- 閱讀權限
- 20
- 性別
- 男
- 註冊時間
- 2018-2-12
- 最後登錄
- 2025-9-17
|
回復 21# Andy2483
早安~ 有找到解決得辦法了
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
想請問一下紅色這段,辦法解釋原因嗎,看不太懂 |
|
發表於 2022-9-15 17:07
| 
