- 帖子
- 1447
- 主題
- 40
- 精華
- 0
- 積分
- 1471
- 點名
- 0
- 作業系統
- Windows 7
- 軟體版本
- Excel 2010 & 2016
- 閱讀權限
- 50
- 性別
- 男
- 來自
- 台灣
- 註冊時間
- 2020-7-15
- 最後登錄
- 2024-12-5
|
43#
發表於 2022-10-21 11:56
| 只看該作者
本帖最後由 Andy2483 於 2022-10-21 12:00 編輯
回復 40# Andy2483
今天回顧此帖把此帖的心得註解一下
當初是亂試成功會跑的! 真的是矇上的!
請各位前輩指正並指導!
Option Explicit
Sub A需求_20220919()
Application.ScreenUpdating = False
Dim x&, i&, QA, QB, T, S, Srr, Arr, Ac, xR, C
Dim Trr, Brr, Crr, Rs, Rq1s, Rq1n, Ras, Ran, B, 特rr, Drr
Dim Rq2s, Rq2n, XA
'↑宣告變數
T = Timer
Set Srr = CreateObject("Scripting.Dictionary")
Set Trr = CreateObject("Scripting.Dictionary")
Set 特rr = CreateObject("Scripting.Dictionary")
'↑令Srr,Trr,特rr是字典
S = Split("A需求,入庫明細,出庫明細,全機種BOM,指圖明細,公司盤點,公司盤點,公司盤點", ",")
'↑令S是一維陣列!裝入 工作表名字串用 "," 符號拆解成8個字串,從0~7
For i = 1 To UBound(S)
'↑設順迴圈設定後7個字串是分別是三個字典的KEY
Set Srr(i) = Sheets(S(i)).Cells
'↑Srr的Item是7個工作表
Set Trr(i) = CreateObject("Scripting.Dictionary")
'↑Trr的Item是7個新字典
Set 特rr(i) = CreateObject("Scripting.Dictionary")
'↑特rr的Item是7個新字典
Next
Rs = Rows.Count
'↑令Rs是這表的極限列數 1048576
Ac = Sheets(S(0)).Cells(Rs, 1).End(3).Row
'↑令Ac是 "A需求"表的A欄最後一個有內容格
Arr = Range(Sheets(S(0)).[H4], Sheets(S(0)).Cells(Ac, 1))
'↑令Arr是陣列裝入 Ac 與 "A需求"表的[H4] ,
'這兩個對角格涵蓋的方正最小區域儲存格值
特rr(1) = Array("", 1, 18, 1, 15, 0, 1, 1, 19, "A倉") '入庫合計
'↑將陣列值當ITEM,KEY是0~9 倒入 特rr(1)這字典中的字典
'↑字典中的字典KEY 0 的ITEM 是"" 空字元,是後面程序沒有用到的
'純粹是要讓後面程序從key 1 開始引用
'↑字典中的字典KEY 1 ,KEY 2 ITEM(1, 18)
',是用來指引第1個表 "入庫明細" 表要取R欄資料
'↑字典中的字典KEY 3 ,KEY 4 ITEM(1, 15)
',是用來指引第1個表 "入庫明細" 表要取O欄資料
'↑字典中的字典KEY 5 ,KEY 6 ITEM(0, 1)
',是備用的!如果樓主的需求在結果表還要增加條件用的
'↑字典中的字典KEY 7 ,KEY 8 ITEM(1, 19)
',是用來指引第1個表 "入庫明細" 表要取S欄資料
'↑字典中的字典KEY 9 ITEM是 "A倉" (第二個判斷條件關鍵字)
'↓後續依上述類推, 裡面的 99 是CU欄的意思
特rr(2) = Array("", 2, 18, 2, 15, 0, 1, 2, 19, "A倉") '出庫合計
特rr(3) = Array("", 3, 26, 3, 16, 0, 1, 3, 20, "A倉") '全機種BOM-總需求
特rr(4) = Array("", 4, 12, 4, 6, 0, 1, 4, 10, "A倉") '指圖明細-總出貨
特rr(5) = Array("", 5, 6, 5, 1, 0, 1, 5, 99, "") '公司盤點-A倉
特rr(6) = Array("", 6, 11, 6, 1, 0, 1, 6, 99, "") '公司盤點-A倉調整
特rr(7) = Array("", 7, 7, 7, 1, 0, 1, 7, 99, "") '盤點表
For i = 1 To UBound(S)
'↑設外順迴圈從 1 到 S陣列的最後一個 7
Set Rq1s = Srr(特rr(i)(3))(1, 特rr(i)(4))
Set Rq1n = Srr(特rr(i)(3))(Rs, 特rr(i)(4)).End(3)
Brr = Srr(特rr(i)(3)).Range(Rq1s, Rq1n)
'↑令Brr是陣列 將條件1的儲存格值資料倒入,當被搜尋的關鍵字
Set Rq2s = Srr(特rr(i)(7))(1, 特rr(i)(8))
Set Rq2n = Srr(特rr(i)(7))(Rq1n.Row, 特rr(i)(8))
Drr = Srr(特rr(i)(7)).Range(Rq2s, Rq2n)
'↑令Drr是陣列 將條件2的儲存格值資料倒入,當被搜尋的關鍵字
Set Ras = Srr(特rr(i)(1))(1, 特rr(i)(2))
Set Ran = Srr(特rr(i)(1))(Rq1n.Row, 特rr(i)(2))
Crr = Srr(特rr(i)(1)).Range(Ras, Ran)
'↑令Crr是陣列 結果儲存格值資料倒入
For x = 1 To UBound(Brr)
'↑設內順迴圈從 1 到 第1條件的最後個
B = Brr(x, 1)
'↑貨品編號
If InStr(Drr(x, 1), 特rr(i)(9)) Or Drr(x, 1) & 特rr(i)(9) = "" Then
'↑如果第二條件成立 或
'第二條件的關鍵字欄格值與 特rr(i)第9個ITEM 組合的字串是空字元
'因為 如果沒有第二條件判斷的工作表資料!也要創立字典供後續引用
''此範例CU欄一定是空格,與特rr(i)(9) = ""組合字串也是空格!
'所以第二條件一定會成立!
'因為第一條件就是 貨品編號 是字典一定會納入
Trr(i)(B) = Trr(i)(B) + Crr(x, 1)
'↑條件成立就把 貨品編號當key去除重複,結果儲存格值累加當item
End If
Next
Next
For i = 1 To Ac - 3
'↑設順迴圈將資料帶入或計算後再帶入!
xR = Arr(i, 1)
Arr(i, 4) = Trr(7)(xR)
Arr(i, 5) = Trr(3)(xR)
Arr(i, 6) = Trr(1)(xR) + Trr(2)(xR)
Arr(i, 8) = Trr(5)(xR) + Trr(6)(xR)
If Trr(3)(xR) = 0 Then Arr(i, 5) = 0
If Trr(7)(xR) = 0 Then Arr(i, 4) = 0
If Trr(1)(xR) + Trr(2)(xR) = 0 Then Arr(i, 6) = 0
If Trr(5)(xR) + Trr(6)(xR) = 0 Then Arr(i, 8) = 0
Arr(i, 7) = Trr(5)(xR) + Trr(6)(xR) + Trr(1)(xR) + Trr(2)(xR) - Trr(3)(xR)
If Arr(i, 7) >= 0 Then Arr(i, 7) = 0
Next i
Sheets(S(0)).[A4].Resize(UBound(Arr), 8) = Arr
MsgBox "共耗時：" & Timer - T & " 秒"
End Sub |
|
