Board logo

標題: [發問] 如何提高多條件加總效率 SUMIFS vs SUMPRODUCT vs VBA [打印本頁]

作者: sunnyso    時間: 2013-6-1 04:43     標題: 如何提高多條件加總效率 SUMIFS vs SUMPRODUCT vs VBA

多條件加總效率 SUMIFS最快,SUMPRODUCT 次之
我寫的VBA最慢。
不知道各位大大能否指點一下,是否有辦法提高VBA的效率。

[attach]15127[/attach]
作者: c_c_lai    時間: 2013-6-1 16:35

回復 1# sunnyso
請教一個問題:
  1. fSumIFs = "=SUMIFS(原始資料!R2C3:R" & RowsCnt & "C3,原始資料!R2C1:R" & RowsCnt & "C1,總表!RC1,原始資料!R2C5:R" & RowsCnt & "C5, COLUMN(R[-3]C[-1]))"
複製代碼
其中最尾端之 COLUMN(R[-3]C[-1]) 指的是? 它的用意何在?
謝謝你!
作者: sunnyso    時間: 2013-6-1 16:50

回復 2# c_c_lai

=column(a1)=1 to 12 (月)
作者: c_c_lai    時間: 2013-6-1 18:41

回復  c_c_lai

=column(a1)=1 to 12 (月)
sunnyso 發表於 2013-6-1 16:50

原來如此,萬分感激!
作者: c_c_lai    時間: 2013-6-1 22:26

回復 1# sunnyso
試試這個程式碼,耗時 0.921875
  1. Sub Ex_VBA_Array()          '  VBA Code Array
  2.     Dim RowsCnt As Long, m As Long, SubTotalAr() As Double
  3.     Dim t1 As Variant, t2 As Variant, AllType As Variant
  4.     Dim DataArea As Variant
  5.     Dim i%, j%
  6.    
  7.     t1 = Timer
  8.     AllType = Array("A類", "B類", "C類", "D類", "E類", "F類", "G類", "H類", "I類", "J類")
  9.     ReDim SubTotalAr(0 To UBound(AllType), 0 To 11)
  10.     Application.ScreenUpdating = False
  11.    
  12.     '  清理舊數據
  13.     '  Sheets("總表").Activate
  14.     Sheets("總表").Range("A3").CurrentRegion.Offset(1, 1).Clear
  15.    
  16.     With Sheets("原始資料")
  17.         RowsCnt = .Range("A1").CurrentRegion.Rows.Count
  18.         DataArea = .Range("A2").Resize(RowsCnt, 3)
  19.         
  20.         For m = 1 To UBound(DataArea)
  21.             For i = 0 To UBound(AllType) '  A類 To J類
  22.                 If DataArea(m, 1) = AllType(i) Then           ' Jan to Dec
  23.                     SubTotalAr(i, Month(DataArea(m, 2)) - 1) = SubTotalAr(i, Month(DataArea(m, 2)) - 1) + DataArea(m, 3)
  24.                 End If
  25.             Next i
  26.         Next m
  27.     End With
  28.    
  29.     With Sheets("總表")
  30.         .Range("B4").Resize(UBound(AllType) + 1, 12) = SubTotalAr
  31.         .Range("N4:N13").FormulaR1C1 = "=SUM(RC[-12]:RC[-1])"
  32.         For i = 0 To 3
  33.             '  .Range(Chr(79 + i) & 4 & ":" & Chr(79 + i) & 13).FormulaR1C1 = "=SUM(RC[-" & (13 - i * 2) & "]:RC[-" & (11 - i * 2) & "])"
  34.             .Range(Chr(79 + i) & 4).Resize(UBound(AllType) + 1).FormulaR1C1 = "=SUM(RC[-" & (13 - i * 2) & "]:RC[-" & (11 - i * 2) & "])"
  35.             .Range(Chr(79 + i) & 4).Resize(UBound(AllType) + 1) = .Range(Chr(79 + i) & 4).Resize(UBound(AllType) + 1).Value
  36.         Next i
  37.         .Range("B14:R14").FormulaR1C1 = "=SUM(R[-10]C:R[-1]C)"
  38.     End With
  39.     Application.ScreenUpdating = True
  40.     t2 = Timer
  41.     MsgBox "耗時" & t2 - t1
  42.     '  Sheets("原始資料").[F3] = "耗時: " & (t2 - t1)
  43. End Sub
複製代碼
[attach]15130[/attach]
作者: Hsieh    時間: 2013-6-1 23:22

回復 1# sunnyso
  1. Sub ex()
  2. Dim ap(11, 17), s#, i&, j%, k%, cnt#
  3. s = Timer
  4. Set dic = CreateObject("Scripting.Dictionary") '月
  5. ay = Array("1月", "2月", "3月", "4月", "5月", "6月", "7月", "8月", "9月", "10月", "11月", "12月", "", "1季", "2季", "3季", "4季")
  6. ak = Array("A類", "B類", "C類", "D類", "E類", "F類", "G類", "H類", "I類", "J類")
  7. With Sheets("原始資料")
  8.    ar = .Range("A1").CurrentRegion.Value
  9.    For i = 2 To UBound(ar, 1)
  10.       dic(ar(i, 1) & Month(ar(i, 2)) & "月") = dic(ar(i, 1) & Month(ar(i, 2)) & "月") + ar(i, 3) '月
  11.       dic(ar(i, 1)) = dic(ar(i, 1)) + ar(i, 3)   '累計
  12.       dic(ar(i, 1) & Int((Month(ar(i, 2)) - 1) / 3) + 1 & "季") = dic(ar(i, 1) & Int((Month(ar(i, 2)) - 1) / 3) + 1 & "季") + ar(i, 3)
  13.    Next
  14. End With
  15. For j = 0 To 16
  16. cnt = 0
  17.    For k = 0 To 9
  18.       ap(k, j) = dic(ak(k) & ay(j))
  19.       cnt = cnt + dic(ak(k) & ay(j))
  20.    Next
  21.     ap(10, j) = cnt
  22. Next
  23. Sheets("總表").[B4].Resize(11, 17) = ap
  24. MsgBox Timer - s
  25. End Sub
複製代碼

作者: sunnyso    時間: 2013-6-2 00:16

回復 6# Hsieh
感謝超版, 字典法妙. 讓我用時間好好消化一下. 有問題再問. Thanks in advance.

這裡真是個長知識的地方。高手如云。
作者: ML089    時間: 2013-6-2 08:42

回復 1# sunnyso

有意思的比較,我測試結果和你的不同

1.662109375        SUMIF
9.76953125        AutoFilter
4.728515625        VBA CODE
10.07226563        SUMPRODUCT
0.654296875        超版Hsieh
0.3359375        c_c_lai

SUMPRODUCT最慢。公式裡COUNTIF及SUMPRODUCT都是慢郎中函數

.xlsb 開啟時並沒有通知巨集安全的通知,開啟後也可以執行巨集,這是.xlsb 的特性嗎?
作者: sunnyso    時間: 2013-6-4 12:07

回復 8# ML089

在另一臺電腦 i3-2120(3.3GHz)+4GRAM, 結果如下
1.301        SUMIFS
3.87        AutoFilter
3.602        VBA CODE
5.023        SUMPRODUCT
0.481        超版Hsieh-字典
10.18        c_c_lai

1.無疑超版的最快
2.SUMIFS次之
3.重點是VBA For Loop 和 SUMPRODUCT、AutoFilter的效率對比 (1樓測試在一臺Netbook上)
好像For Loop 受CPU和RAM的限制較明顯。稍後有時間在把Netbook的測試時間放上來。
4.你的硬體配備如何?各位有時時間提供一下硬體配備和測試時間。看看上面的猜測是否正確。
5. 請問你測試c_c_lai的code是測試多少列的資料(70筆,還是52933筆)
6. xlsb的檔案size明顯比xlsx, xlsm小,速度略略快。 還是會有安全提示。我一般會用xlsb來存檔
作者: ML089    時間: 2013-6-4 12:42

回復 9# sunnyso

這是辦公室電腦 CPU: i5-760 2.8GHz / RAM 4G / WIN7-32 / EXCEL 2007
測試資料52993筆,就是你的檔案我再將超版Hsieh及c_c_lai  VBAC CODE複製進來及執行
1.223         SUMIF
8.074         AutoFilter
4.148         VBA CODE
6.652         SUMPRODUCT
0.574         超版Hsieh
0.418         c_c_lai

c_c_lai 的時間好像差異很大

XLSB開啟有VBA安全性確認(上次在家裡測試沒有出現,)


這是我執行的檔案
[attach]15158[/attach]
作者: sunnyso    時間: 2013-6-4 12:54

回復 10# ML089

看來CPU的cache對物件的讀取效率有很大影響
作者: stillfish00    時間: 2013-6-4 20:05

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

作者: ML089    時間: 2013-6-5 21:15

回復 13# sunnyso


    不只快很多,0.312秒,是最快的
作者: ML089    時間: 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. 會更快
複製代碼

作者: sunnyso    時間: 2013-6-6 08:40

回復 15# ML089

的確會更快

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

p.s. 這�媟Q討論比較通用的條件加總加速法
這�堛爾禤えO參照論壇�堨t一個貼編出來的, 當初沒有考慮到它的特殊性。
作者: sunnyso    時間: 2013-6-6 09:09

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


當然設計程序時充分利用問題的特性絕對是正確的。
作者: ML089    時間: 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
作者: sunnyso    時間: 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
作者: sunnyso    時間: 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
複製代碼

作者: sunnyso    時間: 2013-6-6 11:54

本帖最後由 sunnyso 於 2013-6-6 11:56 編輯

回復 18# ML089

有一個想法, 利用VBA 的 InStr(),filter, join 等 函數。但是還沒想到具體如何實現
作者: sunnyso    時間: 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
作者: sunnyso    時間: 2013-6-6 15:06

把資料從工作表讀入陣列, 再作運算, 運算成陣列,再寫入工作表
這樣要快很多, 例如樓上的例子
作者: ML089    時間: 2013-6-6 15:10

回復 22# sunnyso

以前都是直接利用儲存格運算存取,經過這次比較才了解不同的方式差異那麼大,真得滿有收穫的。
所以要做查詢運算還是要全部先讀至變數陣列,全部計算好了再將變數陣列一次性指向給儲存格。

執行時間差很多,執行test2後會死當6分鐘,剛好可以喝一杯咖啡。
test1 1.4秒
test2 299.3秒
作者: sunnyso    時間: 2013-6-6 15:32

回復 24# ML089

不知道的會以為電腦當機了, 強行結束Excel會破壞excel檔,造成損失
作者: ML089    時間: 2013-6-6 16:03

回復 22# sunnyso

如何在Sheet3執行巨集test1,資料寫至Sheet1
我加了紅色字結果執行錯誤,幫忙看看錯在哪裡,
在Sheet1執行巨集test1就正確

    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
    Sheets("Sheet1").Range(Cells(1, 1), Cells(1001, 1001)) = Ar
End Sub

[attach]15187[/attach]
作者: sunnyso    時間: 2013-6-6 16:39

本帖最後由 sunnyso 於 2013-6-6 16:43 編輯

回復 26# ML089

1. Change it to
Sheets("Sheet3").Range("A1").Resize(1000,1000) = Ar

2. or Change it to
     With Sheets("Sheet3")
        .Range(.Cells(1, 1), .Cells(1000, 1000)) = Ar
     End With

3. .xls - Excel 2003 and below  only have 256 Columns ("IV")
作者: sunnyso    時間: 2013-6-6 16:53

回復 18# ML089

MATCH 可以用 Scripting.Dictionary來實現
試下面的code
  1. Sub sonny3_dict()
  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.     AllMnth = Array("1月", "2月", "3月", "4月", "5月", "6月", "7月", "8月", "9月", "10月", "11月", "12月")
  8.     ReDim SubTotalAr(0 To UBound(AllType), 0 To 11)
  9.     Set TypeDict = CreateObject("Scripting.Dictionary")
  10.     Set MnthDict = CreateObject("Scripting.Dictionary")
  11.     For i = 0 To UBound(AllType)
  12.         TypeDict(AllType(i)) = i
  13.     Next i
  14.         For i = 0 To UBound(AllMnth)
  15.         TypeDict(AllMnth(i)) = i
  16.     Next i

  17.     Application.ScreenUpdating = False
  18.     With Sheets("原始資料")
  19.         RowsCnt = .Range("A1").CurrentRegion.Rows.Count
  20.         DataArea = .Range("A2").Resize(RowsCnt - 1, 3)
  21.     End With
  22.     For m = 1 To UBound(DataArea)
  23.         i = TypeDict(DataArea(m, 1))
  24.         j = MnthDict(Month(DataArea(m, 2)) & "月")
  25.         SubTotalAr(i, j) = SubTotalAr(i, j) + DataArea(m, 3)
  26.     Next m
  27.    
  28.     With Sheets("總表")
  29.         .Range("B4").Resize(UBound(AllType) + 1, 12) = SubTotalAr
  30.         .Range("B14:R14").FormulaR1C1 = "=SUM(R[-10]C:R[-1]C)"
  31.         .Range("N4:N13").FormulaR1C1 = "=SUM(RC[-12]:RC[-1])"
  32.         .Range("O4:R13").FormulaR1C1 = "=SUM(RC[-13]:RC[-11])"
  33.     End With
  34.     Application.ScreenUpdating = True
  35.     t2 = Timer
  36.     Sheets("原始資料").Range("m7") = t2 - t1
  37.     MsgBox "耗時" & t2 - t1
  38. End Sub
複製代碼

作者: ML089    時間: 2013-6-6 23:10

回復 27# sunnyso

各式的執行時間並無太大差異
Range(Cells(1,1),Cells(1001,1001)) 應該是等於 Range("A1:ALL1000"),可是不能執行無法理解,只好記下來。



下式執行錯誤
Sheets("Sheet1").Range(Cells(1,1),Cells(1001,1001))=Ar

下式執行OK-1.5秒
WithSheets("Sheet1")
.Range(.Cells(1,1),.Cells(1000,1000))=Ar
EndWith

下式執行OK-1.5秒
Sheets("Sheet1").Range("A1").Resize(1000,1000)=Ar

下式執行OK-1.5秒
Sheet1.[A1].Resize(1000,1000)=Ar

下式執行OK-1.5秒
Sheet1.[A1:ALL1000]=Ar

下式執行OK-1.5秒
Sheet1.Range("A1:ALL1000")=Ar
作者: sunnyso    時間: 2013-6-6 23:27

本帖最後由 sunnyso 於 2013-6-6 23:30 編輯

回復 29# ML089

如果你在sheet3, 要把資料寫入sheet1

Sheets("Sheet1").Range(Sheets("Sheet1").Cells(1,1),Sheets("Sheet1").Cells(1001,1001))=Ar

因為cells(1, 1) 是 sheets("sheet3").cells(1,1), 不能用於sheet1 的range
作者: ML089    時間: 2013-6-6 23:33

回復 28# sunnyso

Scripting.Dictionary 沒有直接用迴圈比較來的快
作者: ML089    時間: 2013-6-6 23:39

回復 30# sunnyso

感謝!受教
你的解釋我懂了
作者: sunnyso    時間: 2013-6-6 23:45

本帖最後由 sunnyso 於 2013-6-7 00:00 編輯

回復 31# ML089

會比Match快嗎?

另外,在Netbook(N470 1.83GHz)上字典法快過迥圈,
作者: c_c_lai    時間: 2013-6-7 06:17

看完1#附件,第一反應是覺得第三種方法的VBA CODE 中 For下的不太好,要為他平反 !!! 應該是像c_c_lai大這樣 ...
stillfish00 發表於 2013-6-4 20:05

謝謝指導!
Exit Sub 適度的置入,的確能避掉不必要的浪費迴圈,
用變數來取代確實也有些許的助益,如果 Month()
使用頻率大的話,那就會有很大地效率提升了。
再次向你說聲謝謝。
作者: c_c_lai    時間: 2013-6-7 06:25

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

如此修改後確實有不錯效益提升。
多角度的思維亦能考驗與增進我們思考的能力。
謝謝你。
作者: ML089    時間: 2013-6-7 09:00

回復 33# sunnyso


在PC上i5 2.8GHz RAM-4G上速度快慢比較
迴圈比較 > 字典查詢 > MATCH查詢

不同硬體有不同的效果,甚至第二次執行都比第一次執行快,但大致方向可以藉由這次體驗獲得一些寶貴經驗。
作者: sunnyso    時間: 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:
  1. Option Explicit
  2. Private WithEvents App As Application
  3. Private Sub Class_Initialize()
  4. Set App = Application
  5. End Sub
  6. Private Sub App_AfterCalculate()
  7. ClearCache
  8. 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.
作者: sunnyso    時間: 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在陣列中位置
例如
  1. Sub ss_test()
  2.     alltype = Array("A類", "B類", "C類", "D類", "E類", "F類", "G類", "H類", "I類", "J類")
  3.     aj = "D類"
  4.     Debug.Print UBound(Split(Split(Join(alltype, "|"), aj)(0), "|")) + 1
  5.    
  6.     Stop
  7. End Sub
複製代碼

作者: ML089    時間: 2013-6-30 23:41

回復 38# sunnyso


    好想法
作者: sunnyso    時間: 2013-6-30 23:46

回復 39# ML089

有bug, 改爲
  1. Sub ss_test()
  2.     alltype = Array("A類", "B類", "C類", "D類", "E類", "F類", "G類", "H類", "I類", "J類")
  3.     aj = "D類"
  4.     Debug.Print UBound(Split(Split(“ ” & Join(alltype, "|"), aj)(0), "|"))
  5.    
  6.     Stop
  7. End Sub
複製代碼

作者: sunnyso    時間: 2013-6-30 23:59

回復 39# ML089

好像還是 loop 快
  1. Sub sonny3_v3() 'VBA split+join
  2.     t1 = Timer
  3.     Dim RowsCnt, m, SubTotalAr() As Double
  4.     Dim DataArea As Variant
  5.     Dim i%, j%
  6.     AllType = " A類|B類|C類|D類|E類|F類|G類|H類|I類|J類"
  7.     ReDim SubTotalAr(0 To 9, 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 = UBound(Split(Split(AllType, DataArea(m, 1))(0), "|"))
  14.             j = -1
  15.             Do
  16.                 j = j + 1
  17.             Loop Until Month(DataArea(m, 2)) = (j + 1)
  18.             SubTotalAr(i, j) = SubTotalAr(i, j) + DataArea(m, 3)
  19.         Next m
  20.     End With
  21.    
  22.     With Sheets("總表")
  23.         .Range("B4").Resize(9 + 1, 12) = SubTotalAr
  24.         .Range("B14:R14").FormulaR1C1 = "=SUM(R[-10]C:R[-1]C)"
  25.         .Range("N4:N13").FormulaR1C1 = "=SUM(RC[-12]:RC[-1])"
  26.         .Range("O4:R13").FormulaR1C1 = "=SUM(RC[-13]:RC[-11])"
  27.     End With
  28.     Application.ScreenUpdating = True
  29.     t2 = Timer
  30.     MsgBox "耗時" & t2 - t1
  31. End Sub
複製代碼

作者: ML089    時間: 2013-7-1 09:51

回復 41# sunnyso

我測試結果也是一樣
UBound(Split(Split( 用了3個函數,Split( 這種文字函數應該也比較慢

這例子學習到:
EXCEL 函數 比 VBA函數慢很多
文字函數 比 數字函數慢
減少迴圈適時跳出
減少函數使用量
作者: sunnyso    時間: 2013-7-1 09:53

本帖最後由 sunnyso 於 2013-7-1 09:56 編輯

回復 42# ML089

完全同意
另加

VBA用陣列,減少讀寫worksheet次數

Worksheet 減少用陣列公式 (ctrl+shift+Enter)
作者: sunnyso    時間: 2013-7-1 10:14

本帖最後由 sunnyso 於 2013-7-1 10:24 編輯
回復  ML089

完全同意
另加

VBA用陣列,減少讀寫worksheet次數

Worksheet 減少用陣列公式 (ctrl+shift+Enter)

sunnyso 發表於 2013-7-1 09:53


不要歧視輔助欄,因爲陣列公式比輔助欄慢

陣列公式適合小型計算,(和學習練功)
作者: ML089    時間: 2013-7-5 12:23

回復 43# sunnyso


VBA將資料一次讀入陣列再做計算比較快,不知道陣列大小有無限制。
如果資料量很大超過陣列限制時有無處理方式。
目前我想將9個文字檔(每個檔案約3~5萬行,每行80字)同時直接讀入陣列再來處理,請教這種方式是否可行。
作者: stillfish00    時間: 2013-7-5 13:43

回復 45# ML089
限制應該就是記憶體大小吧,把資料讀到陣列理論上就是讀到記憶體內,用stop中斷並觀察工作管理員>處理程序>Excel.exe所佔的記憶體大小可以得知。但記憶體又分階層:快取、實體、虛擬,如果讀入資料過大而使用到虛擬記憶體(其實就是硬碟分頁檔),速度就沒原本那麼快了。
作者: ML089    時間: 2013-7-5 17:08

回復 46# stillfish00

謝謝回覆

查詢下列網頁
http://msdn.microsoft.com/zh-tw/library/b388cb5s(v=vs.80).aspx

裡面說到,每個陣列之維度長度都受限於 Integer 資料型別的最大值,也就是 (2 ^ 31) - 1,然而,陣列之總大小也同時受限於系統可用的記憶體。
所以說可宣告數量應該不是問題,可是受限於系統可用的記憶體。
後續處理時真的遇到問題再來請教大家。


------------------------------------------------------------------------
Visual Basic 中的陣列大小

Visual Studio 2005 其他版本 本主題尚未接受評分 - 為這個主題評分
陣列大小為其所有維度 (Dimension) 長度之乘積。它代表目前包含於陣列中的元素總數。
下列範例宣告一個三維陣列︰
Dim prices(3, 4, 5) As Long
變數 prices 陣列的整體大小為 (3 + 1) x (4 + 1) x (5 + 1) = 120。

陣列大小考慮事項
處理陣列大小時,請注意幾點︰
維度長度
每個維度的索引都 以 0 為起點,也就是它的範圍是由 0 到它的上限 (Upper Bound)。因此,指定維度的長度會比該維度的宣告上限多 1。

長度限制
每個陣列之維度長度都受限於 Integer 資料型別的最大值,也就是 (2 ^ 31) - 1。然而,陣列之總大小也同時受限於系統可用的記憶體。若您試圖對總大小超過可用的 RAM 之陣列進行初始化,Common Language Runtime 將擲回 OutOfMemoryException 例外狀況。

大小及元素大小
陣列大小與其元素的資料型別無關。大小永遠是指元素的總數,而不是它們於儲存體中所佔的位元組。
記憶體消耗量
對陣列在記憶體中的儲存方式做任何假設都是不安全的。儲存體會因不同資料寬度的平台而有差異,所以相同陣列於 64 位元系統上所佔記憶體將較 32 位元系統來的多。當您初始化陣列時,隨著系統組態不同,Common Language Runtime (CLR) 會指派儲存體盡可能將元素存放在一起,或是根據實體硬體界限將它們全部加以調整。同時,陣列需要耗用儲存體以供其控制資訊使用,此消耗量會隨著維度增加而增加。
作者: sunnyso    時間: 2013-7-5 18:29

回復 47# ML089

感謝ML089,
作者: stillfish00    時間: 2013-7-5 19:33

回復 47# ML089
非常詳盡的資訊,謝謝,又學到了不少。
作者: GBKEE    時間: 2013-7-6 05:51

回復 47# ML089
   
處理陣列大小時,請注意幾點︰
維度長度
每個維度的索引都 以 0 為起點,也就是它的範圍是由 0 到它的上限 (Upper Bound)。因此,指定維度的長度會比該維度的宣告上限多 1。
也可以是這樣的


[attach]15376[/attach]
作者: ML089    時間: 2013-7-6 09:17

回復 50# GBKEE

謝謝補充說明
陣列的索引上下指標也可以自訂




歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)