- 帖子
- 2035
- 主題
- 24
- 精華
- 0
- 積分
- 2031
- 點名
- 0
- 作業系統
- Win7
- 軟體版本
- Office2010
- 閱讀權限
- 100
- 性別
- 男
- 註冊時間
- 2012-3-22
- 最後登錄
- 2024-2-1
|
回復 1# sunnyso
試試這個程式碼，耗時 0.921875- Sub Ex_VBA_Array() ' VBA Code Array
- Dim RowsCnt As Long, m As Long, SubTotalAr() As Double
- Dim t1 As Variant, t2 As Variant, AllType As Variant
- Dim DataArea As Variant
- Dim i%, j%
-
- t1 = Timer
- AllType = Array("A類", "B類", "C類", "D類", "E類", "F類", "G類", "H類", "I類", "J類")
- ReDim SubTotalAr(0 To UBound(AllType), 0 To 11)
- Application.ScreenUpdating = False
-
- ' 清理舊數據
- ' Sheets("總表").Activate
- Sheets("總表").Range("A3").CurrentRegion.Offset(1, 1).Clear
-
- With Sheets("原始資料")
- RowsCnt = .Range("A1").CurrentRegion.Rows.Count
- DataArea = .Range("A2").Resize(RowsCnt, 3)
-
- For m = 1 To UBound(DataArea)
- For i = 0 To UBound(AllType) ' A類 To J類
- If DataArea(m, 1) = AllType(i) Then ' Jan to Dec
- SubTotalAr(i, Month(DataArea(m, 2)) - 1) = SubTotalAr(i, Month(DataArea(m, 2)) - 1) + DataArea(m, 3)
- End If
- Next i
- Next m
- End With
-
- With Sheets("總表")
- .Range("B4").Resize(UBound(AllType) + 1, 12) = SubTotalAr
- .Range("N4:N13").FormulaR1C1 = "=SUM(RC[-12]:RC[-1])"
- For i = 0 To 3
- ' .Range(Chr(79 + i) & 4 & ":" & Chr(79 + i) & 13).FormulaR1C1 = "=SUM(RC[-" & (13 - i * 2) & "]:RC[-" & (11 - i * 2) & "])"
- .Range(Chr(79 + i) & 4).Resize(UBound(AllType) + 1).FormulaR1C1 = "=SUM(RC[-" & (13 - i * 2) & "]:RC[-" & (11 - i * 2) & "])"
- .Range(Chr(79 + i) & 4).Resize(UBound(AllType) + 1) = .Range(Chr(79 + i) & 4).Resize(UBound(AllType) + 1).Value
- Next i
- .Range("B14:R14").FormulaR1C1 = "=SUM(R[-10]C:R[-1]C)"
- End With
- Application.ScreenUpdating = True
- t2 = Timer
- MsgBox "耗時" & t2 - t1
- ' Sheets("原始資料").[F3] = "耗時： " & (t2 - t1)
- End Sub
|
|
發表於 2013-6-1 16:35
| 
