123
返回列表 上一主題 發帖

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

sunnyso

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

熱烈參與勳章好學求知勳章
11# 跳轉到 »
發表於 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 

熱烈參與勳章好學求知勳章
12#
發表於 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 

熱烈參與勳章好學求知勳章
13#
發表於 2013-6-6 15:06 | 顯示全部帖子
把資料從工作表讀入陣列, 再作運算, 運算成陣列,再寫入工作表
這樣要快很多, 例如樓上的例子
ss

TOP

sunnyso

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

熱烈參與勳章好學求知勳章
14#
發表於 2013-6-6 15:32 | 顯示全部帖子
回復 24# ML089

不知道的會以為電腦當機了, 強行結束Excel會破壞excel檔,造成損失
ss

TOP

sunnyso

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

熱烈參與勳章好學求知勳章
15#
發表於 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")
ss

TOP

sunnyso

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

熱烈參與勳章好學求知勳章
16#
發表於 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

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

TOP

sunnyso

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

熱烈參與勳章好學求知勳章
17#
發表於 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
ss

TOP

sunnyso

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

熱烈參與勳章好學求知勳章
18#
發表於 2013-6-6 23:45 | 顯示全部帖子
本帖最後由 sunnyso 於 2013-6-7 00:00 編輯

回復 31# ML089

會比Match快嗎?

另外,在Netbook（N470 1.83GHz)上字典法快過迥圈,
ss

TOP

sunnyso

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

熱烈參與勳章好學求知勳章
19#
發表於 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.
ss

TOP

sunnyso

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

熱烈參與勳章好學求知勳章
20#
發表於 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
複製代碼
ss

TOP

        靜思自在 : 不怕事多，只怕多事。
123
返回列表 上一主題