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

samwang

帖子: 976
主題: 7
精華: 0
積分: 1018
點名: 0
作業系統: Win10
軟體版本: Office 2016
閱讀權限: 50
性別: 男
註冊時間: 2013-4-19
最後登錄: 2025-1-10

32^#

發表於 2022-9-16 19:09 | 只看該作者

回復 Andy2483

前輩~你看看這個,我套用samwang前輩方式去整理出來!
執行速度很快,但是目前遇到的問題 ...
s3526369 發表於 2022-9-16 16:45

附件看不出哪裡有公式，後學光看那些程式碼就快....，您都可以套用寫出，建議將原來有公式區可以轉成VBA，
這樣也可以提升效率，謝謝

s3526369

　暱稱: 大榮

中學生 Rank: 2

帖子: 45
主題: 3
精華: 0
積分: 72
點名: 0
作業系統: WIN7
軟體版本: Office 2007
閱讀權限: 20
性別: 男
註冊時間: 2018-2-12
最後登錄: 2025-3-27

33^#

發表於 2022-9-17 00:14 | 只看該作者

本帖最後由 s3526369 於 2022-9-17 00:16 編輯

回復 32# samwang

前輩你好~我倉庫庫存A.B是連結材料表的資料,我重新上傳附件!

倉庫合計TEST2.rar (626.37 KB)

samwang

帖子: 976
主題: 7
精華: 0
積分: 1018
點名: 0
作業系統: Win10
軟體版本: Office 2016
閱讀權限: 50
性別: 男
註冊時間: 2013-4-19
最後登錄: 2025-1-10

34^#

發表於 2022-9-17 06:57 | 只看該作者

回復 samwang

前輩你好~我倉庫庫存A.B是連結材料表的資料,我重新上傳附件!
s3526369 發表於 2022-9-17 00:14

請測試看看，謝謝

倉庫合計TEST2_0917.zip (627.58 KB)

　暱稱: 厚臉皮的學生

帖子: 1447
主題: 40
精華: 0
積分: 1471
點名: 0
作業系統: Windows 7
軟體版本: Excel 2010 & 2016
閱讀權限: 50
性別: 男
來自: 台灣
註冊時間: 2020-7-15
最後登錄: 2025-5-5

35^#

發表於 2022-9-17 09:56 | 只看該作者

太厲害了!
33# 祥龍十八掌
34# 打通任督二脈

　暱稱: 厚臉皮的學生

帖子: 1447
主題: 40
精華: 0
積分: 1471
點名: 0
作業系統: Windows 7
軟體版本: Excel 2010 & 2016
閱讀權限: 50
性別: 男
來自: 台灣
註冊時間: 2020-7-15
最後登錄: 2025-5-5

36^#

發表於 2022-9-17 16:48 | 只看該作者

回復 33# s3526369

提醒前輩
下方紅字處須改為2

Sub 倉庫庫存()
Dim Arr, xD, xD1, xD2, xD3, xD4, xD5, xD6, xD7, T$, i&, QA, QB
Set xD = CreateObject("Scripting.Dictionary") '入庫合計
Set xD1 = CreateObject("Scripting.Dictionary")  '公司總需求
Set xD2 = CreateObject("Scripting.Dictionary")  'A倉
Set xD3 = CreateObject("Scripting.Dictionary")  'B倉
Set xD4 = CreateObject("Scripting.Dictionary")  '總出貨
Set xD5 = CreateObject("Scripting.Dictionary")  '盤點數'
Set xD6 = CreateObject("Scripting.Dictionary") '退庫
Set xD7 = CreateObject("Scripting.Dictionary")  '廢料
TM = Timer
With Sheets("入庫明細")
Arr = .Range(.[r1], .[o65536].End(3))
For i = 2 To UBound(Arr)
      T = Arr(i, 1): xD(T) = xD(T) + Arr(i, 4) '入庫合計
Next
End With
With Sheets("全機種BOM")
Arr = .Range(.[Z1], .[p65536].End(3))
For i = 2 To UBound(Arr)
      T = Arr(i, 1): xD1(T) = xD1(T) + Arr(i, 11) '公司總需求
Next
End With
With Sheets("A需求")
Arr = .Range(.[h1], .[A65536].End(3))
For i = 4 To UBound(Arr)
      T = Arr(i, 1): xD2(T) = xD2(T) + Arr(i, 8)  'A倉
Next
End With
With Sheets("B需求")
Arr = .Range(.[h1], .[A65536].End(3))
For i = 4 To UBound(Arr)
      T = Arr(i, 1): xD3(T) = xD3(T) + Arr(i, 8)  'B倉
Next
End With
With Sheets("指圖明細")
Arr = .Range(.[L1], .[f65536].End(3))
For i = 4 To UBound(Arr)
      T = Arr(i, 1): xD4(T) = xD4(T) + Arr(i, 7)  '總出貨
Next
End With
With Sheets("公司盤點")
Arr = .Range(.[G1], .[A65536].End(3))
For i = 4 To UBound(Arr)
      T = Arr(i, 1): xD5(T) = xD5(T) + Arr(i, 7)  '公司盤點
Next
End With

With Sheets("退庫")
Arr = .Range(.[C1], .[A65536].End(3))
For i = 3 To UBound(Arr)
      T = Arr(i, 1): xD6(T) = xD6(T) + Arr(i, 3)  'B倉
Next
End With
With Sheets("廢料倉")
Arr = .Range(.[C1], .[A65536].End(3))
For i = 3 To UBound(Arr)
      T = Arr(i, 1): xD7(T) = xD7(T) + Arr(i, 3)  'B倉
Next
End With

With Sheets("倉庫庫存")
Arr = .Range(.[m3], .[A65536].End(3))
For i = 2 To UBound(Arr)
      T = Arr(i, 1)
      QA = xD5(T) + xD(T) ' ''倉庫庫存
      QB = xD6(T) + xD7(T)
      Arr(i, 5) = xD(T) '入庫合計
      Arr(i, 13) = xD4(T)  '總出貨
      Arr(i, 3) = xD1(T) '總需求
      Arr(i, 8) = QA - QB - xD2(T) - xD3(T) - xD4(T)  '公司倉
      Arr(i, 9) = xD3(T) 'B倉
      Arr(i, 10) = xD2(T)  'A倉
      Arr(i, 7) = QA - QB - xD4(T)  '總數
      Arr(i, 4) = xD5(T)
      Arr(i, 11) = xD6(T)
      Arr(i, 12) = xD7(T)

      If Arr(i, 3) > 0 Then
      XA = xD5(T) + xD(T) - xD6(T) - xD7(T) - Arr(i, 3)
         If XA >= 0 Then XA = "0"
      Else
         XA = "0"
      End If
      If xD(T) = 0 Then Arr(i, 5) = "0"
      If xD5(T) = 0 Then Arr(i, 4) = "0"
      If xD1(T) = 0 Then Arr(i, 3) = "0"
      If xD4(T) = 0 Then Arr(i, 13) = "0"
Arr(i, 6) = XA
Next
.[a3].Resize(UBound(Arr), 13) = Arr
End With
'MsgBox "共耗時：" & Timer - TM & " 秒"
End Sub

　暱稱: 厚臉皮的學生

帖子: 1447
主題: 40
精華: 0
積分: 1471
點名: 0
作業系統: Windows 7
軟體版本: Excel 2010 & 2016
閱讀權限: 50
性別: 男
來自: 台灣
註冊時間: 2020-7-15
最後登錄: 2025-5-5

37^#

發表於 2022-9-17 16:58 | 只看該作者

謝謝兩位前輩
今天習得
1.倒入字典迴圈化
2.預設2條件吻合才加總

Option Explicit
Sub 倉庫庫存_20220917()
Application.ScreenUpdating = False
Dim x&, i&, 值(1 To 17) As Long, QA, QB, T, S, Srr, Arr, Ac, xR, C
Dim Trr, Brr, Crr, Rs, Rq1s, Rq1n, Ras, Ran, B, 欄d, 特rr, Drr
Dim Rq2s, Rq2n, XA
T = Timer
Set Srr = CreateObject("Scripting.Dictionary")
Set Trr = CreateObject("Scripting.Dictionary")
Set 特rr = CreateObject("Scripting.Dictionary")
' 0 1 2 3 4 5 6 7 8
S = Split("倉庫庫存,入庫明細,全機種BOM,A需求,B需求,指圖明細,公司盤點,退庫,廢料倉", ",")
For i = 1 To UBound(S)
Set Srr(i) = Sheets(S(i))
Set Trr(i) = CreateObject("Scripting.Dictionary")
Set 特rr(i) = CreateObject("Scripting.Dictionary")
Next
Rs = Rows.Count
Ac = Sheets(S(0)).Cells(Rs, 1).End(3).Row
Arr = Range(Sheets(S(0)).[N4], Sheets(S(0)).Cells(Ac, 1))
'vS, vC,zS, zC,xS,xC,zS, zC,zV
特rr(1) = Array("", 1, 18, 1, 15, 0, 1, 1, 99, "") '入庫合計
特rr(2) = Array("", 2, 26, 2, 16, 0, 1, 2, 99, "") '公司總需求
特rr(3) = Array("", 3, 8, 3, 1, 0, 1, 3, 99, "") 'A倉
特rr(4) = Array("", 4, 8, 4, 1, 0, 1, 4, 99, "") 'B倉
特rr(5) = Array("", 5, 12, 5, 6, 0, 1, 5, 99, "") '總出貨
特rr(6) = Array("", 6, 7, 6, 1, 0, 1, 6, 99, "") '公司盤點
特rr(7) = Array("", 7, 3, 7, 1, 0, 1, 7, 99, "") 'B倉
特rr(8) = Array("", 8, 3, 8, 1, 0, 1, 8, 99, "") 'B倉
For i = 1 To UBound(S)
Set Rq1s = Srr(特rr(i)(3)).Cells(1, 特rr(i)(4))
Set Rq1n = Srr(特rr(i)(3)).Cells(Rs, 特rr(i)(4)).End(3)
Brr = Srr(特rr(i)(3)).Range(Rq1s, Rq1n)
Set Rq2s = Srr(特rr(i)(7)).Cells(1, 特rr(i)(8))
Set Rq2n = Srr(特rr(i)(7)).Cells(Rq1n.Row, 特rr(i)(8))
Drr = Srr(特rr(i)(7)).Range(Rq2s, Rq2n)
Set Ras = Srr(特rr(i)(1)).Cells(1, 特rr(i)(2))
Set Ran = Srr(特rr(i)(1)).Cells(Rq1n.Row, 特rr(i)(2))
Crr = Srr(特rr(i)(1)).Range(Ras, Ran)
For x = 1 To UBound(Brr)
B = Brr(x, 1)
If InStr(Drr(x, 1), 特rr(i)(9)) Or Drr(x, 1) & 特rr(i)(9) = "" Then
Trr(i)(B) = Trr(i)(B) + Crr(x, 1)
End If
Next
Next
For i = 1 To Ac - 3
xR = Arr(i, 1)
QA = Trr(1)(xR) + Trr(6)(xR) '倉庫庫存
QB = Trr(7)(xR) + Trr(8)(xR)
Arr(i, 5) = Trr(1)(xR) '入庫合計
Arr(i, 13) = Trr(5)(xR) '總出貨
Arr(i, 3) = Trr(2)(xR) '總需求
Arr(i, 8) = QA - QB - Trr(3)(xR) - Trr(4)(xR) - Trr(5)(xR) '公司倉
Arr(i, 9) = Trr(4)(xR) 'B倉
Arr(i, 10) = Trr(3)(xR) 'A倉
Arr(i, 7) = QA - QB - Trr(5)(xR) '總數
Arr(i, 4) = Trr(6)(xR)
Arr(i, 11) = Trr(7)(xR)
Arr(i, 12) = Trr(8)(xR)
If Arr(i, 3) > 0 Then
XA = Trr(6)(xR) + Trr(1)(xR) - Trr(7)(xR) - Trr(8)(xR) - Arr(i, 3)
If XA >= 0 Then XA = 0
Else
XA = 0
End If
If Trr(1)(xR) = 0 Then Arr(i, 5) = 0
If Trr(6)(xR) = 0 Then Arr(i, 4) = 0
If Trr(2)(xR) = 0 Then Arr(i, 3) = 0
If Trr(5)(xR) = 0 Then Arr(i, 13) = 0
Arr(i, 6) = XA
Next i
C = Array(, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13)
For i = 1 To UBound(C)
Sheets(S(0)).Cells(4, C(i)).Resize(UBound(Arr), 1) = Application.Index(Arr, , C(i))
Next
MsgBox "共耗時：" & Timer - T & " 秒"
End Sub

複製代碼

　暱稱: 厚臉皮的學生