123456
返回列表 上一主題 發帖

[發問] 如何提高多條件加總效率 SUMIFS vs SUMPRODUCT vs VBA

sunnyso

帖子
605 
主題
92 
精華
0 
積分
648 
點名
0  
作業系統
windows 
軟體版本
7 
閱讀權限
50 
性別
男 
來自
macau 
註冊時間
2013-4-5 
最後登錄
2019-2-10 

熱烈參與勳章好學求知勳章
11# 跳轉到 »
發表於 2013-6-4 12:54 | 只看該作者
回復 10# ML089

看來CPU的cache對物件的讀取效率有很大影響
ss

TOP

stillfish00

帖子
1018 
主題
15 
精華
0 
積分
1058 
點名
0  
作業系統
win7 32bit 
軟體版本
Office 2016 64-bit 
閱讀權限
50 
性別
男 
來自
桃園 
註冊時間
2012-5-9 
最後登錄
2022-9-28 
12#
發表於 2013-6-4 20:05 | 只看該作者
看完1#附件，第一反應是覺得第三種方法的VBA CODE 中 For下的不太好，要為他平反 !!! 應該是像c_c_lai大這樣才對~~~。
另外5# c_c_lai的code，要再追求效率的話，可以在23行後加個Exit For  ，應該能再提升一些效率。
或者用變數存放Month(...)計算出來的值(這個影響比較小..)。

TOP

sunnyso

帖子
605 
主題
92 
精華
0 
積分
648 
點名
0  
作業系統
windows 
軟體版本
7 
閱讀權限
50 
性別
男 
來自
macau 
註冊時間
2013-4-5 
最後登錄
2019-2-10 

熱烈參與勳章好學求知勳章
13#
發表於 2013-6-5 00:23 | 只看該作者
回復 12# stillfish00

Stillfish00大大的確厲害，那個code果然有問題，改了一下（快了很多），請指教
  1. Sub sonny3_v2()
  2.     t1 = Timer
  3.     Dim RowsCnt, m, SubTotalAr() As Double
  4.     Dim DataArea As Variant
  5.     Dim i%, j%
  6.     AllType = Array("A類", "B類", "C類", "D類", "E類", "F類", "G類", "H類", "I類", "J類")
  7.     ReDim SubTotalAr(0 To UBound(AllType), 0 To 11)
  8.     Application.ScreenUpdating = False
  9.     With Sheets("原始資料")
  10.         RowsCnt = .Range("A1").CurrentRegion.Rows.Count
  11.         DataArea = .Range("A2").Resize(RowsCnt - 1, 3)
  12.         For m = 1 To UBound(DataArea)
  13.             i = -1
  14.             Do
  15.                 i = i + 1
  16.             Loop Until DataArea(m, 1) = AllType(i)
  17.             j = -1
  18.             Do
  19.                 j = j + 1
  20.             Loop Until Month(DataArea(m, 2)) = (j + 1)
  21.             SubTotalAr(i, j) = SubTotalAr(i, j) + DataArea(m, 3)
  22.         Next m
  23.     End With
  24.    
  25.     With Sheets("總表")
  26.         .Range("B4").Resize(UBound(AllType) + 1, 12) = SubTotalAr
  27.         .Range("B14:R14").FormulaR1C1 = "=SUM(R[-10]C:R[-1]C)"
  28.         .Range("N4:N13").FormulaR1C1 = "=SUM(RC[-12]:RC[-1])"
  29.         .Range("O4:R13").FormulaR1C1 = "=SUM(RC[-13]:RC[-11])"
  30.     End With
  31.     Application.ScreenUpdating = True
  32.     t2 = Timer
  33.     MsgBox "耗時" & t2 - t1
  34. End Sub
複製代碼
ss

TOP

ML089

帖子
2025 
主題
13 
精華
0 
積分
2053 
點名
0  
作業系統
WIN7 
軟體版本
Office2007 
閱讀權限
100 
性別
男 
來自
台北市 
註冊時間
2011-3-2 
最後登錄
2024-3-14 

論壇榮譽勳章論壇贊助勳章熱烈參與勳章2014馬年全勤獎章2015羊年全勤獎章2016猴年全勤獎章
14#
發表於 2013-6-5 21:15 | 只看該作者
回復 13# sunnyso


    不只快很多，0.312秒，是最快的
{...} 表示需要用 CTRL+SHIFT+ENTER 三鍵輸入公式

TOP

ML089

帖子
2025 
主題
13 
精華
0 
積分
2053 
點名
0  
作業系統
WIN7 
軟體版本
Office2007 
閱讀權限
100 
性別
男 
來自
台北市 
註冊時間
2011-3-2 
最後登錄
2024-3-14 

論壇榮譽勳章論壇贊助勳章熱烈參與勳章2014馬年全勤獎章2015羊年全勤獎章2016猴年全勤獎章
15#
發表於 2013-6-5 21:38 | 只看該作者
回復 13# sunnyso
  1. j = -1
  2. Do
  3. j = j + 1
  4. Loop Until Month(DataArea(m, 2)) = (j + 1)
  5. 改為下式
  6. j = Month(DataArea(m, 2)) - 1
  7. 會更快
複製代碼
{...} 表示需要用 CTRL+SHIFT+ENTER 三鍵輸入公式

TOP

sunnyso

帖子
605 
主題
92 
精華
0 
積分
648 
點名
0  
作業系統
windows 
軟體版本
7 
閱讀權限
50 
性別
男 
來自
macau 
註冊時間
2013-4-5 
最後登錄
2019-2-10 

熱烈參與勳章好學求知勳章
16#
發表於 2013-6-6 08:40 | 只看該作者
回復 15# ML089

的確會更快

但是只能用在這種特殊情況, 例如條件二為地區（中部,東北部,南部...）就不適用

p.s. 這裏想討論比較通用的條件加總加速法
這裏的資料是參照論壇裏另一個貼編出來的, 當初沒有考慮到它的特殊性。
ss

TOP

sunnyso

帖子
605 
主題
92 
精華
0 
積分
648 
點名
0  
作業系統
windows 
軟體版本
7 
閱讀權限
50 
性別
男 
來自
macau 
註冊時間
2013-4-5 
最後登錄
2019-2-10 

熱烈參與勳章好學求知勳章
17#
發表於 2013-6-6 09:09 | 只看該作者
回復  sunnyso
ML089 發表於 2013-6-5 21:38


當然設計程序時充分利用問題的特性絕對是正確的。
ss

TOP

ML089

帖子
2025 
主題
13 
精華
0 
積分
2053 
點名
0  
作業系統
WIN7 
軟體版本
Office2007 
閱讀權限
100 
性別
男 
來自
台北市 
註冊時間
2011-3-2 
最後登錄
2024-3-14 

論壇榮譽勳章論壇贊助勳章熱烈參與勳章2014馬年全勤獎章2015羊年全勤獎章2016猴年全勤獎章
18#
發表於 2013-6-6 09:29 | 只看該作者
回復 16# sunnyso

A CODE 修改為 B CODE，執行時間由 0.257秒變慢為1.304秒，變得很慢
在VBA內用活頁簿函數會增加很多時間
不知VBA內有無其他可取代MATCH函數

' *** A CODE ***
i = -1
Do
i = i + 1
Loop Until DataArea(m, 1) = AllType(i)

' *** B CODE ***
i = Application.Match(DataArea(m, 1), AllType, 0) - 1
{...} 表示需要用 CTRL+SHIFT+ENTER 三鍵輸入公式

TOP

sunnyso

帖子
605 
主題
92 
精華
0 
積分
648 
點名
0  
作業系統
windows 
軟體版本
7 
閱讀權限
50 
性別
男 
來自
macau 
註冊時間
2013-4-5 
最後登錄
2019-2-10 

熱烈參與勳章好學求知勳章
19#
發表於 2013-6-6 09:52 | 只看該作者
回復 18# ML089
Netbook  N470 (1.83GHz) + 2GRAM 測試結果

4.234375        SUMIFS
21.234375        AutoFilter
26.953125        VBA Code
18.203125        SUMPRODUCT
1.078125        超版Hsieh
1.390625        New VBA Code
ss

TOP

sunnyso

帖子
605 
主題
92 
精華
0 
積分
648 
點名
0  
作業系統
windows 
軟體版本
7 
閱讀權限
50 
性別
男 
來自
macau 
註冊時間
2013-4-5 
最後登錄
2019-2-10 

熱烈參與勳章好學求知勳章
20#
發表於 2013-6-6 11:51 | 只看該作者
回復 15# ML089

結合ML089的方法，利用原始資料的特性下面的CODE更快
  1. Sub sonny3_v3()
  2.     t1 = Timer
  3.     Dim RowsCnt, m, SubTotalAr() As Double
  4.     Dim DataArea As Variant
  5.     Dim i%, j%
  6.     AllTypeStr = "A類B類C類D類E類F類G類H類I類J類"
  7.     ReDim SubTotalAr(0 To UBound(AllType), 0 To 11)
  8.     Application.ScreenUpdating = False
  9.     With Sheets("原始資料")
  10.         RowsCnt = .Range("A1").CurrentRegion.Rows.Count
  11.         DataArea = .Range("A2").Resize(RowsCnt - 1, 3)
  12.         For m = 1 To UBound(DataArea)
  13.             i = (InStr(AllTypeStr, "D類") + 1) / 2
  14.             j = Month(DataArea(m, 2)) - 1
  15.             SubTotalAr(i, j) = SubTotalAr(i, j) + DataArea(m, 3)
  16.         Next m
  17.     End With
  18.    
  19.     With Sheets("總表")
  20.         .Range("B4").Resize(UBound(AllType) + 1, 12) = SubTotalAr
  21.         .Range("B14:R14").FormulaR1C1 = "=SUM(R[-10]C:R[-1]C)"
  22.         .Range("N4:N13").FormulaR1C1 = "=SUM(RC[-12]:RC[-1])"
  23.         .Range("O4:R13").FormulaR1C1 = "=SUM(RC[-13]:RC[-11])"
  24.     End With
  25.     Application.ScreenUpdating = True
  26.     t2 = Timer
  27.     MsgBox "耗時" & t2 - t1
  28. End Sub
複製代碼
ss

TOP

        靜思自在 : 一個人不怕錯，就怕不改過，改過並不難。
123456
返回列表 上一主題