123456
返回列表 上一主題 發帖

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

sunnyso

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

熱烈參與勳章好學求知勳章
22# 跳轉到 »
發表於 2013-6-6 13:23 | 只看該作者
回復 18# ML089

一般來說要提高巨集效率應該減少使用活頁簿函數和對活頁簿物件的讀寫

Sub test1()
    Dim i%, j%
    Dim Ar(1000, 1000) As Double
    For i = 0 To 1000
        For j = 0 To 1000
            Ar(i, j) = i * 4 + j
        Next j
    Next i
    Range(Cells(1, 1), Cells(1001, 1001)) = Ar
End Sub

Sub test2()
    Dim i%, j%
    For i = 1 To 1000
        For j = 1 To 1000
           Cells(i, j) = i * 4 + j
        Next j
    Next i
End Sub
ss

TOP

sunnyso

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

熱烈參與勳章好學求知勳章
21#
發表於 2013-6-6 11:54 | 只看該作者
本帖最後由 sunnyso 於 2013-6-6 11:56 編輯

回復 18# ML089

有一個想法， 利用VBA 的 InStr()，filter, join 等 函數。但是還沒想到具體如何實現
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

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

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 

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


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

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

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

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

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

        靜思自在 : 【為善競爭】人生要為善競爭，分秒必爭。
123456
返回列表 上一主題