s3526369

回復 34# samwang


    感謝前輩 ~測試可以!

s3526369

回復 36# Andy2483
謝謝你 有修改了
回復 40# Andy2483
前輩~也太厲害了!很多種方法,有點看不太懂,但慢慢研究應該可以理解!

Andy2483

回復 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

singo1232001

Sub 倉庫庫存()
Set d = CreateObject("Scripting.Dictionary")
r = Sheets("材料表").Cells(Rows.Count, 1).End(3).Row
For Each Z In Sheets("材料表").Range("a2:a" & r)
d(Z.Value) = Z.Row - 1
Next
            '1            '2     '3      8      7    9     10     11
sA = Split("全機種BOM,公司盤點,入庫明細,A需求,B需求,退庫,廢料倉,指圖明細", ",")
sB = Split("p:z,a:g,o:r,a:h,a:h,a:c,a:c,f:l", ",")
ReDim Ar(1 To d.Count, 1 To 11) As Double

For i = 0 To UBound(sA) '放資料
Set s = Sheets(sA(i))
sC = Split(sB(i), ":")
r = s.Cells(Rows.Count, sC(0)).End(3).Row
    c = Split("1,2,3,8,7,9,10,11", ",")(i)
    For j = 1 To r
     If d.exists(s.Cells(j, sC(0)).Value) Then
        Ar(d(s.Cells(j, sC(0)).Value), c) = Ar(d(s.Cells(j, sC(0)).Value), c) + s.Cells(j, sC(1)).Value
     End If
    Next
Next

For i = 1 To UBound(Ar)  '計算一下
    a23910 = Ar(i, 3) + Ar(i, 2) - Ar(i, 9) - Ar(i, 10)
    Ar(i, 6) = a23910 - Ar(i, 11) - Ar(i, 8) - Ar(i, 7)
    Ar(i, 5) = a23910 - Ar(i, 11)
    Ar(i, 4) = a23910 - Ar(i, 1)
    If Ar(i, 4) >= 0 Then Ar(i, 4) = 0
Next
Sheets("倉庫庫存").Range("c4").Resize(UBound(Ar) - 1, 11) = Ar
End Sub

singo1232001

回復 44# singo1232001

'有錯 修正一下

    Sub 倉庫庫存2()
Set d = CreateObject("Scripting.Dictionary")
Set s = Sheets("材料表")
For Each Z In s.Range("a2:a" & s.Cells(Rows.Count, 1).End(3).Row)
d(Z.Value) = Z.Row - 1: Next
            '1            '2     '3      8      7    9     10     11
sA = Split("全機種BOM,公司盤點,入庫明細,A需求,B需求,退庫,廢料倉,指圖明細", ",")
sB = Split("p:z,a:g,o:r,a:h,a:h,a:c,a:c,f:l", ",")
ReDim Ar(1 To d.Count, 1 To 11) As Double

For i = 0 To UBound(sA) '放資料
Set s = Sheets(sA(i))
sC = Split(sB(i), ":")
Lr = s.Cells(Rows.Count, sC(0)).End(3).Row
    c = Split("1,2,3,8,7,9,10,11", ",")(i)
    For j = 1 To Lr
     r = s.Cells(j, sC(0)).Value
      If d.exists(r) Then Ar(d(r), c) = Ar(d(r), c) + s.Cells(j, sC(1)).Value
    Next
Next

For i = 1 To UBound(Ar)  '計算一下
    a23910 = Ar(i, 3) + Ar(i, 2) - Ar(i, 9) - Ar(i, 10)
    Ar(i, 4) = a23910 - Ar(i, 1): If Ar(i, 4) >= 0 Then Ar(i, 4) = 0
    Ar(i, 5) = a23910 - Ar(i, 11)
    Ar(i, 6) = Ar(i, 5) - Ar(i, 8) - Ar(i, 7)
Next
Sheets("倉庫庫存").Range("c4").Resize(UBound(Ar) - 1, 11) = Ar
End Sub

Andy2483

回復 45# singo1232001


    謝謝前輩指導
以下是今天學習心得註解!如有冒犯請見諒!
請前輩指正並指導!謝謝!
Option Explicit
Sub 倉庫庫存2()
Dim d, S, sA, sB, Ar, Z, sC, Lr, j, i, C, r, a23910
Set d = CreateObject("Scripting.Dictionary")
'↑令d是字典
Set S = Sheets("材料表")
'↑令d是物件 "材料表" 工作表!以下稱 材料表
For Each Z In S.Range("a2:a" & S.Cells(Rows.Count, 1).End(3).Row)
'↑#設順迴圈令Z是 材料表 [A2]到A欄的最後一格中的一格,所以Z是物件儲存格
   d(Z.Value) = Z.Row - 1   '@
   '↑把上述#儲存格值當key倒入d字典裡,item是Z所在的列位數-1
Next
sA = Split("全機種BOM,公司盤點,入庫明細,A需求,B需求,退庫,廢料倉,指圖明細", ",")
'↑令 sA是一維陣列,倒入用 "," 分割工作表字串組,成為8個字串 從0~7
sB = Split("p:z,a:g,o:r,a:h,a:h,a:c,a:c,f:l", ",")
'↑令 sB是一維陣列,倒入用 "," 分割儲存格欄位 關鍵字欄:搜尋結果欄
ReDim Ar(1 To d.Count, 1 To 11) As Double
'↑宣告 Ar是數字陣列,縱向從1 到d字典裡元素數列,橫向從1 到11欄
For i = 0 To UBound(sA) '放資料
'↑設外順迴圈,從0開始到 sA一維陣列的最後一個數 7
   Set S = Sheets(sA(i))
   '↑令S是 物件 迴圈裡的工作表 以下稱(迴圈表)
   sC = Split(sB(i), ":")
   '↑令 sC是一維陣列 倒入用 ":" 分割sB一維陣列裡的迴圈指定字串
   Lr = S.Cells(Rows.Count, sC(0)).End(3).Row
   '↑令 Lr是迴圈表裡指定的 材料料號欄 有內容的最後列數
   C = Split("1,2,3,8,7,9,10,11", ",")(i)
   '↑令 C是一維陣列 倒入用 "," 分割結果表欄位字串
   For j = 1 To Lr
   '↑設內順迴圈 從1 到 迴圈表裡指定的 材料料號欄 有內容的最後列數
      r = S.Cells(j, sC(0)).Value
     '↑令r是 迴圈表裡 材料料號欄內迴圈儲存格的值,以下稱(關鍵字)
      If d.exists(r) Then
      '↑如果 關鍵字在字典裡查得到
         Ar(d(r), C) = Ar(d(r), C) + S.Cells(j, sC(1)).Value
         '↑Ar陣列位址: @標示處字典d,key為關鍵字,的Item列位,結果表欄位
         '讓陣列中的結果值累加搜尋關鍵字得到的結果欄數量值
      End If
   Next
Next
For i = 1 To UBound(Ar)  '計算一下
    a23910 = Ar(i, 3) + Ar(i, 2) - Ar(i, 9) - Ar(i, 10)
    Ar(i, 4) = a23910 - Ar(i, 1): If Ar(i, 4) >= 0 Then Ar(i, 4) = 0
    Ar(i, 5) = a23910 - Ar(i, 11)
    Ar(i, 6) = Ar(i, 5) - Ar(i, 8) - Ar(i, 7)
Next
Sheets("倉庫庫存").Range("c4").Resize(UBound(Ar), 11) = Ar
'↑將結果陣列值從"倉庫庫存"表[C4]貼入!
'用材料表的關鍵字找資料!貼到"倉庫庫存"表!風險剖大!
End Sub