123456
返回列表 上一主題 發帖

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

sunnyso

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

TOP

sunnyso

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

TOP

sunnyso

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

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

TOP

ML089

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

論壇榮譽勳章論壇贊助勳章熱烈參與勳章2014馬年全勤獎章2015羊年全勤獎章2016猴年全勤獎章
24#
發表於 2013-6-6 15:10 | 只看該作者
回復 22# sunnyso

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

執行時間差很多，執行test2後會死當6分鐘，剛好可以喝一杯咖啡。
test1 1.4秒
test2 299.3秒
{...} 表示需要用 CTRL+SHIFT+ENTER 三鍵輸入公式

TOP

sunnyso

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

熱烈參與勳章好學求知勳章
25#
發表於 2013-6-6 15:32 | 只看該作者
回復 24# ML089

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

TOP

ML089

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

論壇榮譽勳章論壇贊助勳章熱烈參與勳章2014馬年全勤獎章2015羊年全勤獎章2016猴年全勤獎章
26#
發表於 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

VBA 變數陣列與儲存格計算批次讀寫比較.rar (9.47 KB)
{...} 表示需要用 CTRL+SHIFT+ENTER 三鍵輸入公式

TOP

sunnyso

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

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

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

ML089

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

論壇榮譽勳章論壇贊助勳章熱烈參與勳章2014馬年全勤獎章2015羊年全勤獎章2016猴年全勤獎章
29#
發表於 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
{...} 表示需要用 CTRL+SHIFT+ENTER 三鍵輸入公式

TOP

sunnyso

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

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

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