sunnyso

回復 18# ML089

有一個想法， 利用VBA 的 InStr()，filter, join 等 函數。但是還沒想到具體如何實現

sunnyso

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

把資料從工作表讀入陣列, 再作運算, 運算成陣列,再寫入工作表
這樣要快很多, 例如樓上的例子

ML089

回復 22# sunnyso

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

執行時間差很多，執行test2後會死當6分鐘，剛好可以喝一杯咖啡。
test1 1.4秒
test2 299.3秒

sunnyso

回復 24# ML089

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

ML089

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

下載次數: 12

2013-6-6 16:03

sunnyso

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

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

複製代碼

ML089

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

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