- 帖子
- 605
- 主題
- 92
- 精華
- 0
- 積分
- 648
- 點名
- 0
- 作業系統
- windows
- 軟體版本
- 7
- 閱讀權限
- 50
- 性別
- 男
- 來自
- macau
- 註冊時間
- 2013-4-5
- 最後登錄
- 2019-2-10
 
|
回復 39# ML089
好像還是 loop 快- Sub sonny3_v3() 'VBA split+join
- t1 = Timer
- Dim RowsCnt, m, SubTotalAr() As Double
- Dim DataArea As Variant
- Dim i%, j%
- AllType = " A類|B類|C類|D類|E類|F類|G類|H類|I類|J類"
- ReDim SubTotalAr(0 To 9, 0 To 11)
- Application.ScreenUpdating = False
- With Sheets("原始資料")
- RowsCnt = .Range("A1").CurrentRegion.Rows.Count
- DataArea = .Range("A2").Resize(RowsCnt - 1, 3)
- For m = 1 To UBound(DataArea)
- i = UBound(Split(Split(AllType, DataArea(m, 1))(0), "|"))
- j = -1
- Do
- j = j + 1
- Loop Until Month(DataArea(m, 2)) = (j + 1)
- SubTotalAr(i, j) = SubTotalAr(i, j) + DataArea(m, 3)
- Next m
- End With
-
- With Sheets("總表")
- .Range("B4").Resize(9 + 1, 12) = SubTotalAr
- .Range("B14:R14").FormulaR1C1 = "=SUM(R[-10]C:R[-1]C)"
- .Range("N4:N13").FormulaR1C1 = "=SUM(RC[-12]:RC[-1])"
- .Range("O4:R13").FormulaR1C1 = "=SUM(RC[-13]:RC[-11])"
- End With
- Application.ScreenUpdating = True
- t2 = Timer
- MsgBox "耗時" & t2 - t1
- End Sub
複製代碼 |
|