　暱稱: 大榮

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

1^# 跳轉到 » 倒序看帖

打印

字體大小: tT

發表於 2022-9-13 09:48 | 只看該作者

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

以下是我目前可以執行但是運算時間有點久
請問有更好的方法可以去取代嗎

Sub 倉庫庫存合計()
Dim X, i As Long
For i = 4 To Sheets("倉庫庫存").[A1000].End(3).Row
X = WorksheetFunction.SumIf(Sheets("入庫明細").Range("O2:O600"), Sheets("倉庫庫存").Cells(i, 1), Sheets("入庫明細").Range("R2:R600")) '入庫合計
DA = WorksheetFunction.SumIf(Sheets("全機種BOM").Range("P:P"), Sheets("倉庫庫存").Cells(i, 1), Sheets("全機種BOM").Range("Z:Z")) '公司總需求
BA = WorksheetFunction.SumIf(Sheets("A需求").Range("A:A"), Sheets("倉庫庫存").Cells(i, 1), Sheets("A需求").Range("H:H")) 'A倉
bb = WorksheetFunction.SumIf(Sheets("b需求").Range("A:A"), Sheets("倉庫庫存").Cells(i, 1), Sheets("B需求").Range("H:H")) 'B倉
BC = WorksheetFunction.SumIf(Sheets("指圖明細").Range("F:F"), Sheets("倉庫庫存").Cells(i, 1), Sheets("指圖明細").Range("L:L")) '總出貨
FY = WorksheetFunction.SumIf(Sheets("出庫明細").Range("H2:H600"), Sheets("廢料倉").Cells(i, 1) & Sheets("廢料倉").Cells(1, 1), Sheets("出庫明細").Range("I2:I600")) '廢料
FX = WorksheetFunction.SumIf(Sheets("指圖明細").Range("F2:F2000"), Sheets("廢料倉").Cells(i, 1), Sheets("指圖明細").Range("K2:K2000")) '廢料
EY = WorksheetFunction.SumIf(Sheets("出庫明細").Range("H2:H600"), Sheets("退庫").Cells(i, 1) & Sheets("退庫").Cells(1, 1), Sheets("出庫明細").Range("I2:I600")) '退庫
QA = Sheets("倉庫庫存").Cells(i, 4) + Sheets("倉庫庫存").Cells(i, 5) ' ''倉庫庫存
QB = Sheets("倉庫庫存").Cells(i, "K") + Sheets("倉庫庫存").Cells(i, "L")
Sheets("倉庫庫存").Cells(i, 5) = X '入庫合計
Sheets("倉庫庫存").Cells(i, "M") = BC ''總出貨
Sheets("倉庫庫存").Cells(i, "C") = DA ' 總需求
Sheets("倉庫庫存").Cells(i, "H") = QA - QB - BA - bb - BC ''公司倉
Sheets("倉庫庫存").Cells(i, "I") = bb ''B倉
Sheets("倉庫庫存").Cells(i, "J") = BA ''A倉
Sheets("倉庫庫存").Cells(i, "G") = QA - QB - BC ''總數
Sheets("廢料倉").Cells(i, 3) = FY + FX
Sheets("退庫").Cells(i, 3) = EY
Next i
End Sub

複製代碼

樓主熱帖

samwang

大學生 Rank: 4

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

2^#

發表於 2022-9-13 18:09 | 只看該作者

回復 1# s3526369

請問方便附上檔案嗎? 謝謝

TOP

s3526369

　暱稱: 大榮

中學生 Rank: 2

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

3^#

發表於 2022-9-14 08:31 | 只看該作者

回復 2# samwang

好的那我簡化一些再貼上來

TOP

s3526369

　暱稱: 大榮

中學生 Rank: 2

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

4^#

發表於 2022-9-14 08:51 | 只看該作者

回復 2# samwang

倉庫合計.rar (467.23 KB)

檔案在這再麻煩你看看

TOP

Andy2483

　暱稱: 厚臉皮的學生

大學生 Rank: 4

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

5^#

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

本帖最後由 Andy2483 於 2022-9-14 14:41 編輯

回復 4# s3526369

謝謝前輩發表此主題
後學習得很多技巧
1.WorksheetFunction.SumIf的用法
2.工作表放入字典
3.陣列局部放入儲存格

後學的以下方法只節省一點點時間,供前輩參考
拋磚引玉,後學也想學厲害的前輩們的指導

Sub TEST_1()
Application.ScreenUpdating = False
Dim X, i As Long, DA, BA, bb, BC, FY, FX, EY, QA, QB, T
Dim S, Srr, Arr, Ac, xR, c, xC
T = Timer
Set Srr = CreateObject("Scripting.Dictionary")
'0 1 2 3 4 5
S = Split("入庫明細,全機種BOM,A需求,b需求,指圖明細,倉庫庫存", ",")
For i = 0 To UBound(S)
Set Srr(i) = Sheets(S(i))
Next
Ac = Srr(5).Cells(Rows.Count, 1).End(3).Row
Arr = Range(Srr(5).[N4], Srr(5).Cells(Ac, 1))
For i = 1 To Ac - 3
xR = Arr(i, 1)
Arr(i, 5) = WorksheetFunction.SumIf(Srr(0).[O:O], xR, Srr(0).[R:R]) '入庫合計
Arr(i, 3) = WorksheetFunction.SumIf(Srr(1).[P:P], xR, Srr(1).[Z:Z]) '公司總需求
Arr(i, 10) = WorksheetFunction.SumIf(Srr(2).[A:A], xR, Srr(2).[H:H]) 'A倉
Arr(i, 9) = WorksheetFunction.SumIf(Srr(3).[A:A], xR, Srr(3).[H:H]) 'B倉
Arr(i, 13) = WorksheetFunction.SumIf(Srr(4).[F:F], xR, Srr(4).[L:L]) '總出貨
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
MsgBox "共耗時：" & Timer - T & " 秒"
End Sub

複製代碼

TOP

s3526369

　暱稱: 大榮

中學生 Rank: 2

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

6^#

發表於 2022-9-14 18:36 | 只看該作者

回復 5# Andy2483

厲害了~感謝前輩幫我解惑
我再好好研究研究!

TOP

samwang

大學生 Rank: 4

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

7^#

發表於 2022-9-15 08:07 | 只看該作者

回復 samwang

檔案在這再麻煩你看看
s3526369 發表於 2022-9-14 08:51

請測試看看，謝謝
Sub test()
Dim Arr, xD, xD1, xD2, xD3, xD4, 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")  '總出貨
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(.[m3], .[a65536].End(3))
For i = 2 To UBound(Arr)
      T = Arr(i, 1)
      QA = Arr(i, 4) + Arr(i, 5) ' ''倉庫庫存
      QB = Arr(i, 11) + Arr(i, 12)
      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)  '總數
Next
.[a3].Resize(UBound(Arr), 13) = Arr
End With
MsgBox "共耗時：" & Timer - TM & " 秒"
End Sub

TOP

Andy2483