12
返回列表 上一主題 發帖

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

Andy2483
　暱稱: 厚臉皮的學生

碩士班Rank: 5Rank: 5

帖子
1567 
主題
40 
精華
0 
積分
1591 
點名
0  
作業系統
Windows 7 
軟體版本
Excel 2010 & 2016 
閱讀權限
100 
性別
男 
來自
台灣 
註冊時間
2020-7-15 
最後登錄
2026-2-2 
11# 跳轉到 »
發表於 2022-9-17 16:58 | 顯示全部帖子
謝謝 兩位前輩
今天習得
1.倒入字典迴圈化
2.預設2條件吻合才加總
  1. Option Explicit
  2. Sub 倉庫庫存_20220917()
  3. Application.ScreenUpdating = False
  4. Dim x&, i&, 值(1 To 17) As Long, QA, QB, T, S, Srr, Arr, Ac, xR, C
  5. Dim Trr, Brr, Crr, Rs, Rq1s, Rq1n, Ras, Ran, B, 欄d, 特rr, Drr
  6. Dim Rq2s, Rq2n, XA
  7. T = Timer
  8. Set Srr = CreateObject("Scripting.Dictionary")
  9. Set Trr = CreateObject("Scripting.Dictionary")
  10. Set 特rr = CreateObject("Scripting.Dictionary")
  11.       '        0        1       2        3     4       5       6      7     8
  12. S = Split("倉庫庫存,入庫明細,全機種BOM,A需求,B需求,指圖明細,公司盤點,退庫,廢料倉", ",")
  13. For i = 1 To UBound(S)
  14.    Set Srr(i) = Sheets(S(i))
  15.    Set Trr(i) = CreateObject("Scripting.Dictionary")
  16.    Set 特rr(i) = CreateObject("Scripting.Dictionary")
  17. Next
  18. Rs = Rows.Count
  19. Ac = Sheets(S(0)).Cells(Rs, 1).End(3).Row
  20. Arr = Range(Sheets(S(0)).[N4], Sheets(S(0)).Cells(Ac, 1))
  21.                   'vS, vC,zS, zC,xS,xC,zS, zC,zV
  22. 特rr(1) = Array("", 1, 18, 1, 15, 0, 1, 1, 99, "") '入庫合計
  23. 特rr(2) = Array("", 2, 26, 2, 16, 0, 1, 2, 99, "") '公司總需求
  24. 特rr(3) = Array("", 3, 8, 3, 1, 0, 1, 3, 99, "") 'A倉
  25. 特rr(4) = Array("", 4, 8, 4, 1, 0, 1, 4, 99, "")  'B倉
  26. 特rr(5) = Array("", 5, 12, 5, 6, 0, 1, 5, 99, "") '總出貨
  27. 特rr(6) = Array("", 6, 7, 6, 1, 0, 1, 6, 99, "")  '公司盤點
  28. 特rr(7) = Array("", 7, 3, 7, 1, 0, 1, 7, 99, "")  'B倉
  29. 特rr(8) = Array("", 8, 3, 8, 1, 0, 1, 8, 99, "")  'B倉
  30. For i = 1 To UBound(S)
  31.    Set Rq1s = Srr(特rr(i)(3)).Cells(1, 特rr(i)(4))
  32.    Set Rq1n = Srr(特rr(i)(3)).Cells(Rs, 特rr(i)(4)).End(3)
  33.    Brr = Srr(特rr(i)(3)).Range(Rq1s, Rq1n)
  34.    
  35.    Set Rq2s = Srr(特rr(i)(7)).Cells(1, 特rr(i)(8))
  36.    Set Rq2n = Srr(特rr(i)(7)).Cells(Rq1n.Row, 特rr(i)(8))
  37.    Drr = Srr(特rr(i)(7)).Range(Rq2s, Rq2n)

  39.    Set Ras = Srr(特rr(i)(1)).Cells(1, 特rr(i)(2))
  40.    Set Ran = Srr(特rr(i)(1)).Cells(Rq1n.Row, 特rr(i)(2))
  41.    Crr = Srr(特rr(i)(1)).Range(Ras, Ran)
  42.    For x = 1 To UBound(Brr)
  43.       B = Brr(x, 1)
  44.       If InStr(Drr(x, 1), 特rr(i)(9)) Or Drr(x, 1) & 特rr(i)(9) = "" Then
  45.          Trr(i)(B) = Trr(i)(B) + Crr(x, 1)
  46.       End If
  47.    Next
  48. Next
  49. For i = 1 To Ac - 3
  50.    xR = Arr(i, 1)
  51.    QA = Trr(1)(xR) + Trr(6)(xR) '倉庫庫存
  52.    QB = Trr(7)(xR) + Trr(8)(xR)
  53.    Arr(i, 5) = Trr(1)(xR)    '入庫合計
  54.    Arr(i, 13) = Trr(5)(xR)  '總出貨
  55.    Arr(i, 3) = Trr(2)(xR)   '總需求
  56.    Arr(i, 8) = QA - QB - Trr(3)(xR) - Trr(4)(xR) - Trr(5)(xR) '公司倉
  57.    Arr(i, 9) = Trr(4)(xR)   'B倉
  58.    Arr(i, 10) = Trr(3)(xR)  'A倉
  59.    Arr(i, 7) = QA - QB - Trr(5)(xR)  '總數
  60.    Arr(i, 4) = Trr(6)(xR)
  61.    Arr(i, 11) = Trr(7)(xR)
  62.    Arr(i, 12) = Trr(8)(xR)
  63.    If Arr(i, 3) > 0 Then
  64.       XA = Trr(6)(xR) + Trr(1)(xR) - Trr(7)(xR) - Trr(8)(xR) - Arr(i, 3)
  65.       If XA >= 0 Then XA = 0
  66.       Else
  67.          XA = 0
  68.    End If
  69.    If Trr(1)(xR) = 0 Then Arr(i, 5) = 0
  70.    If Trr(6)(xR) = 0 Then Arr(i, 4) = 0
  71.    If Trr(2)(xR) = 0 Then Arr(i, 3) = 0
  72.    If Trr(5)(xR) = 0 Then Arr(i, 13) = 0
  73.    Arr(i, 6) = XA
  74. Next i
  75. C = Array(, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13)
  76. For i = 1 To UBound(C)
  77.    Sheets(S(0)).Cells(4, C(i)).Resize(UBound(Arr), 1) = Application.Index(Arr, , C(i))
  78. Next
  79. MsgBox "共耗時：" & Timer - T & " 秒"
  80. End Sub
複製代碼

TOP

Andy2483
　暱稱: 厚臉皮的學生

碩士班Rank: 5Rank: 5

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


        謝謝論壇
        謝謝各位前輩
異想天開!測試OK
Set Srr(i) = Sheets(S(i))
改為
Set Srr(i) = Sheets(S(i)).Cells
後方的Cells都可以省略
  1. Option Explicit
  2. Sub 倉庫庫存_20220919()
  3. Application.ScreenUpdating = False
  4. Dim x&, i&, QA, QB, T, S, Srr, Arr, Ac, xR, C
  5. Dim Trr, Brr, Crr, Rs, Rq1s, Rq1n, Ras, Ran, B, 特rr, Drr
  6. Dim Rq2s, Rq2n, XA
  7. T = Timer
  8. Set Srr = CreateObject("Scripting.Dictionary")
  9. Set Trr = CreateObject("Scripting.Dictionary")
  10. Set 特rr = CreateObject("Scripting.Dictionary")
  11.       '        0        1       2        3     4       5       6      7     8
  12. S = Split("倉庫庫存,入庫明細,全機種BOM,A需求,B需求,指圖明細,公司盤點,退庫,廢料倉", ",")
  13. For i = 1 To UBound(S)
  14.    Set Srr(i) = Sheets(S(i)).Cells
  15.    Set Trr(i) = CreateObject("Scripting.Dictionary")
  16.    Set 特rr(i) = CreateObject("Scripting.Dictionary")
  17. Next
  18. Rs = Rows.Count
  19. Ac = Sheets(S(0)).Cells(Rs, 1).End(3).Row
  20. Arr = Range(Sheets(S(0)).[N4], Sheets(S(0)).Cells(Ac, 1))
  21.                   'vS, vC,zS, zC,xS,xC,zS, zC,zV
  22. 特rr(1) = Array("", 1, 18, 1, 15, 0, 1, 1, 99, "") '入庫合計
  23. 特rr(2) = Array("", 2, 26, 2, 16, 0, 1, 2, 99, "") '公司總需求
  24. 特rr(3) = Array("", 3, 8, 3, 1, 0, 1, 3, 99, "") 'A倉
  25. 特rr(4) = Array("", 4, 8, 4, 1, 0, 1, 4, 99, "")  'B倉
  26. 特rr(5) = Array("", 5, 12, 5, 6, 0, 1, 5, 99, "") '總出貨
  27. 特rr(6) = Array("", 6, 7, 6, 1, 0, 1, 6, 99, "")  '公司盤點
  28. 特rr(7) = Array("", 7, 3, 7, 1, 0, 1, 7, 99, "")  'B倉
  29. 特rr(8) = Array("", 8, 3, 8, 1, 0, 1, 8, 99, "")  'B倉
  30. For i = 1 To UBound(S)
  31.    Set Rq1s = Srr(特rr(i)(3))(1, 特rr(i)(4))
  32.    Set Rq1n = Srr(特rr(i)(3))(Rs, 特rr(i)(4)).End(3)
  33.    Brr = Srr(特rr(i)(3)).Range(Rq1s, Rq1n)
  34.   
  35.    Set Rq2s = Srr(特rr(i)(7))(1, 特rr(i)(8))
  36.    Set Rq2n = Srr(特rr(i)(7))(Rq1n.Row, 特rr(i)(8))
  37.    Drr = Srr(特rr(i)(7)).Range(Rq2s, Rq2n)

  39.    Set Ras = Srr(特rr(i)(1))(1, 特rr(i)(2))
  40.    Set Ran = Srr(特rr(i)(1))(Rq1n.Row, 特rr(i)(2))
  41.    Crr = Srr(特rr(i)(1)).Range(Ras, Ran)
  42.    For x = 1 To UBound(Brr)
  43.       B = Brr(x, 1)
  44.       If InStr(Drr(x, 1), 特rr(i)(9)) Or Drr(x, 1) & 特rr(i)(9) = "" Then
  45.          Trr(i)(B) = Trr(i)(B) + Crr(x, 1)
  46.       End If
  47.    Next
  48. Next
  49. For i = 1 To Ac - 3
  50.    xR = Arr(i, 1)
  51.    QA = Trr(1)(xR) + Trr(6)(xR) '倉庫庫存
  52.    QB = Trr(7)(xR) + Trr(8)(xR)
  53.    Arr(i, 5) = Trr(1)(xR)    '入庫合計
  54.    Arr(i, 13) = Trr(5)(xR)  '總出貨
  55.    Arr(i, 3) = Trr(2)(xR)   '總需求
  56.    Arr(i, 8) = QA - QB - Trr(3)(xR) - Trr(4)(xR) - Trr(5)(xR) '公司倉
  57.    Arr(i, 9) = Trr(4)(xR)   'B倉
  58.    Arr(i, 10) = Trr(3)(xR)  'A倉
  59.    Arr(i, 7) = QA - QB - Trr(5)(xR)  '總數
  60.    Arr(i, 4) = Trr(6)(xR)
  61.    Arr(i, 11) = Trr(7)(xR)
  62.    Arr(i, 12) = Trr(8)(xR)
  63.    If Arr(i, 3) > 0 Then
  64.       XA = Trr(6)(xR) + Trr(1)(xR) - Trr(7)(xR) - Trr(8)(xR) - Arr(i, 3)
  65.       If XA >= 0 Then XA = 0
  66.       Else
  67.          XA = 0
  68.    End If
  69.    If Trr(1)(xR) = 0 Then Arr(i, 5) = 0
  70.    If Trr(6)(xR) = 0 Then Arr(i, 4) = 0
  71.    If Trr(2)(xR) = 0 Then Arr(i, 3) = 0
  72.    If Trr(5)(xR) = 0 Then Arr(i, 13) = 0
  73.    Arr(i, 6) = XA
  74. Next i
  75. C = Array(, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13)
  76. For i = 1 To UBound(C)
  77.    Sheets(S(0)).Cells(4, C(i)).Resize(UBound(Arr), 1) = Application.Index(Arr, , C(i))
  78. Next
  79. MsgBox "共耗時：" & Timer - T & " 秒"
  80. End Sub
複製代碼

TOP

Andy2483
　暱稱: 厚臉皮的學生

碩士班Rank: 5Rank: 5

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


    提醒前輩關於 Sub A需求()
1.Arr(i, 3) 沒有填入值
2.xD3字典創建後沒有被使用
3.求出的值與 初始的範例  倉庫合計.rar  有差異

TOP

Andy2483
　暱稱: 厚臉皮的學生

碩士班Rank: 5Rank: 5

帖子
1567 
主題
40 
精華
0 
積分
1591 
點名
0  
作業系統
Windows 7 
軟體版本
Excel 2010 & 2016 
閱讀權限
100 
性別
男 
來自
台灣 
註冊時間
2020-7-15 
最後登錄
2026-2-2 
14#
發表於 2022-9-19 13:25 | 顯示全部帖子
謝謝 兩位前輩
今天習得
1.倒入字典迴圈化
2.預設2條件吻合才加總
Andy2483 發表於 2022-9-17 16:58


2.預設2條件吻合才加總套入 A需求 可以用
  1. Option Explicit
  2. Sub A需求_20220919()
  3. Application.ScreenUpdating = False
  4. Dim x&, i&, QA, QB, T, S, Srr, Arr, Ac, xR, C
  5. Dim Trr, Brr, Crr, Rs, Rq1s, Rq1n, Ras, Ran, B, 特rr, Drr
  6. Dim Rq2s, Rq2n, XA
  7. T = Timer
  8. Set Srr = CreateObject("Scripting.Dictionary")
  9. Set Trr = CreateObject("Scripting.Dictionary")
  10. Set 特rr = CreateObject("Scripting.Dictionary")
  11.       '        0     1       2        3        4         5        6        7
  12. S = Split("A需求,入庫明細,出庫明細,全機種BOM,指圖明細,公司盤點,公司盤點,公司盤點", ",")
  13. For i = 1 To UBound(S)
  14.    Set Srr(i) = Sheets(S(i)).Cells
  15.    Set Trr(i) = CreateObject("Scripting.Dictionary")
  16.    Set 特rr(i) = CreateObject("Scripting.Dictionary")
  17. Next
  18. Rs = Rows.Count
  19. Ac = Sheets(S(0)).Cells(Rs, 1).End(3).Row
  20. Arr = Range(Sheets(S(0)).[H4], Sheets(S(0)).Cells(Ac, 1))
  21.                   'vS, vC,zS, zC,xS,xC,zS, zC,zV
  22. 特rr(1) = Array("", 1, 18, 1, 15, 0, 1, 1, 19, "A倉") '入庫合計
  23. 特rr(2) = Array("", 2, 18, 2, 15, 0, 1, 2, 19, "A倉") '出庫合計
  24. 特rr(3) = Array("", 3, 26, 3, 16, 0, 1, 3, 20, "A倉") '全機種BOM-總需求
  25. 特rr(4) = Array("", 4, 12, 4, 6, 0, 1, 4, 10, "A倉")  '指圖明細-總出貨
  26. 特rr(5) = Array("", 5, 6, 5, 1, 0, 1, 5, 99, "") '公司盤點-A倉
  27. 特rr(6) = Array("", 6, 11, 6, 1, 0, 1, 6, 99, "")  '公司盤點-A倉調整
  28. 特rr(7) = Array("", 7, 7, 7, 1, 0, 1, 7, 99, "")  '盤點表
  29. For i = 1 To UBound(S)
  30.    Set Rq1s = Srr(特rr(i)(3))(1, 特rr(i)(4))
  31.    Set Rq1n = Srr(特rr(i)(3))(Rs, 特rr(i)(4)).End(3)
  32.    Brr = Srr(特rr(i)(3)).Range(Rq1s, Rq1n)
  33.    
  34.    Set Rq2s = Srr(特rr(i)(7))(1, 特rr(i)(8))
  35.    Set Rq2n = Srr(特rr(i)(7))(Rq1n.Row, 特rr(i)(8))
  36.    Drr = Srr(特rr(i)(7)).Range(Rq2s, Rq2n)

  38.    Set Ras = Srr(特rr(i)(1))(1, 特rr(i)(2))
  39.    Set Ran = Srr(特rr(i)(1))(Rq1n.Row, 特rr(i)(2))
  40.    Crr = Srr(特rr(i)(1)).Range(Ras, Ran)
  41.    For x = 1 To UBound(Brr)
  42.       B = Brr(x, 1)
  43.       If InStr(Drr(x, 1), 特rr(i)(9)) Or Drr(x, 1) & 特rr(i)(9) = "" Then
  44.          Trr(i)(B) = Trr(i)(B) + Crr(x, 1)
  45.       End If
  46.    Next
  47. Next
  48. For i = 1 To Ac - 3
  49.    xR = Arr(i, 1)
  50.    Arr(i, 4) = Trr(7)(xR)
  51.    Arr(i, 5) = Trr(3)(xR)
  52.    Arr(i, 6) = Trr(1)(xR) + Trr(2)(xR)
  53.    Arr(i, 8) = Trr(5)(xR) + Trr(6)(xR)
  54.    If Trr(3)(xR) = 0 Then Arr(i, 5) = 0
  55.    If Trr(7)(xR) = 0 Then Arr(i, 4) = 0
  56.    If Trr(1)(xR) + Trr(2)(xR) = 0 Then Arr(i, 6) = 0
  57.    If Trr(5)(xR) + Trr(6)(xR) = 0 Then Arr(i, 8) = 0
  58.    Arr(i, 7) = Trr(5)(xR) + Trr(6)(xR) + Trr(1)(xR) + Trr(2)(xR) - Trr(3)(xR)
  59.    If Arr(i, 7) >= 0 Then Arr(i, 7) = 0
  60. Next i
  61. Sheets(S(0)).[A4].Resize(UBound(Arr), 8) = Arr
  62. MsgBox "共耗時：" & Timer - T & " 秒"
  63. End Sub
複製代碼

TOP

Andy2483
　暱稱: 厚臉皮的學生

碩士班Rank: 5Rank: 5

帖子
1567 
主題
40 
精華
0 
積分
1591 
點名
0  
作業系統
Windows 7 
軟體版本
Excel 2010 & 2016 
閱讀權限
100 
性別
男 
來自
台灣 
註冊時間
2020-7-15 
最後登錄
2026-2-2 
15#
發表於 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

TOP

Andy2483
　暱稱: 厚臉皮的學生

碩士班Rank: 5Rank: 5

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

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

TOP

        靜思自在 : 生氣，就是拿別人的過錯來懲罰自己。
12
返回列表 上一主題