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

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

熱烈參與勳章好學求知勳章

41^#

發表於 2013-6-30 23:59 | 只看該作者

回復 39# ML089

好像還是 loop 快

Sub sonny3_v3() 'VBA split+join
t1 = Timer
Dim RowsCnt, m, SubTotalAr() As Double
Dim DataArea As Variant
Dim i%, j%
AllType = " A類|B類|C類|D類|E類|F類|G類|H類|I類|J類"
ReDim SubTotalAr(0 To 9, 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 = UBound(Split(Split(AllType, DataArea(m, 1))(0), "|"))
j = -1
Do
j = j + 1
Loop Until Month(DataArea(m, 2)) = (j + 1)
SubTotalAr(i, j) = SubTotalAr(i, j) + DataArea(m, 3)
Next m
End With
With Sheets("總表")
.Range("B4").Resize(9 + 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

複製代碼

ss

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

熱烈參與勳章好學求知勳章

40^#

發表於 2013-6-30 23:46 | 只看該作者

回復 39# ML089

有bug，改爲

Sub ss_test()
alltype = Array("A類", "B類", "C類", "D類", "E類", "F類", "G類", "H類", "I類", "J類")
aj = "D類"
Debug.Print UBound(Split(Split(“ ” & Join(alltype, "|"), aj)(0), "|"))
Stop
End Sub

複製代碼

ss

版主 Rank: 7 Rank: 7 Rank: 7

ML089

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

論壇榮譽勳章論壇贊助勳章熱烈參與勳章 2014馬年全勤獎章 2015羊年全勤獎章 2016猴年全勤獎章

39^#

發表於 2013-6-30 23:41 | 只看該作者

回復 38# sunnyso

好想法

{...} 表示需要用 CTRL+SHIFT+ENTER 三鍵輸入公式

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

熱烈參與勳章好學求知勳章

38^#

發表於 2013-6-30 22:46 | 只看該作者

回復 18# ML089

回復 sunnyso
A CODE 修改為 B CODE，執行時間由 0.257秒變慢為1.304秒，變得很慢
在VBA內用活頁簿函數會增加很多時間
不知VBA內有無其他可取代MATCH函數
ML089 發表於 2013-6-6 09:29

不用迴圈，不用Worksheet函數（match等），判斷某element在陣列中位置
例如

Sub ss_test()
alltype = Array("A類", "B類", "C類", "D類", "E類", "F類", "G類", "H類", "I類", "J類")
aj = "D類"
Debug.Print UBound(Split(Split(Join(alltype, "|"), aj)(0), "|")) + 1
Stop
End Sub

複製代碼

ss

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

熱烈參與勳章好學求知勳章

37^#

發表於 2013-6-7 10:13 | 只看該作者

回復 36# ML089

第二次執行因爲有Cache所以會比較快，用下面的code 可以在計算結束後清除Cache， but only for Excel 2007 and above

added a Class Module called AppEvents with code like this:

Option Explicit
Private WithEvents App As Application
Private Sub Class_Initialize()
Set App = Application
End Sub
Private Sub App_AfterCalculate()
ClearCache
End Sub

複製代碼

Only Excel 2007 and later have the AfterCalculate event which will be used to empty the cache after each calculate
This code is ignored in Excel 2003 and earlier: since the AfterCalculate event does not exist it never gets called but still compiles OK.

ss