sunnyso

回復 10# ML089

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

stillfish00

看完1#附件，第一反應是覺得第三種方法的VBA CODE 中 For下的不太好，要為他平反 !!! 應該是像c_c_lai大這樣才對~~~。
另外5# c_c_lai的code，要再追求效率的話，可以在23行後加個Exit For  ，應該能再提升一些效率。
或者用變數存放Month(...)計算出來的值(這個影響比較小..)。

sunnyso

回復 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

複製代碼

ML089

回復 13# sunnyso


    不只快很多，0.312秒，是最快的

ML089

回復 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. 會更快

複製代碼

sunnyso

回復 15# ML089

的確會更快

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

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

sunnyso

回復  sunnyso
ML089 發表於 2013-6-5 21:38

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

ML089

回復 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

sunnyso

回復 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

sunnyso

回復 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

複製代碼