如何提高多條件加總效率 SUMIFS vs SUMPRODUCT vs VBA - Excel程式區

帖子: 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

帖子: 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 等函數。但是還沒想到具體如何實現

帖子: 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更快

Sub sonny3_v3()
t1 = Timer
Dim RowsCnt, m, SubTotalAr() As Double
Dim DataArea As Variant
Dim i%, j%
AllTypeStr = "A類B類C類D類E類F類G類H類I類J類"
ReDim SubTotalAr(0 To UBound(AllType), 0 To 11)
Application.ScreenUpdating = False
With Sheets("原始資料")
RowsCnt = .Range("A1").CurrentRegion.Rows.Count
DataArea = .Range("A2").Resize(RowsCnt - 1, 3)
For m = 1 To UBound(DataArea)
i = (InStr(AllTypeStr, "D類") + 1) / 2
j = Month(DataArea(m, 2)) - 1
SubTotalAr(i, j) = SubTotalAr(i, j) + DataArea(m, 3)
Next m
End With
With Sheets("總表")
.Range("B4").Resize(UBound(AllType) + 1, 12) = SubTotalAr
.Range("B14:R14").FormulaR1C1 = "=SUM(R[-10]C:R[-1]C)"
.Range("N4:N13").FormulaR1C1 = "=SUM(RC[-12]:RC[-1])"
.Range("O4:R13").FormulaR1C1 = "=SUM(RC[-13]:RC[-11])"
End With
Application.ScreenUpdating = True
t2 = Timer
MsgBox "耗時" & t2 - t1
End Sub

複製代碼

帖子: 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

版主 Rank: 7 Rank: 7 Rank: 7

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 三鍵輸入公式