- 帖子
- 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- Sub sonny3_dict()
- t1 = Timer
- Dim RowsCnt, m, SubTotalAr() As Double
- Dim DataArea As Variant
- Dim i%, j%
- AllType = Array("A類", "B類", "C類", "D類", "E類", "F類", "G類", "H類", "I類", "J類")
- AllMnth = Array("1月", "2月", "3月", "4月", "5月", "6月", "7月", "8月", "9月", "10月", "11月", "12月")
- ReDim SubTotalAr(0 To UBound(AllType), 0 To 11)
- Set TypeDict = CreateObject("Scripting.Dictionary")
- Set MnthDict = CreateObject("Scripting.Dictionary")
- For i = 0 To UBound(AllType)
- TypeDict(AllType(i)) = i
- Next i
- For i = 0 To UBound(AllMnth)
- TypeDict(AllMnth(i)) = i
- Next i
- Application.ScreenUpdating = False
- With Sheets("原始資料")
- RowsCnt = .Range("A1").CurrentRegion.Rows.Count
- DataArea = .Range("A2").Resize(RowsCnt - 1, 3)
- End With
- For m = 1 To UBound(DataArea)
- i = TypeDict(DataArea(m, 1))
- j = MnthDict(Month(DataArea(m, 2)) & "月")
- SubTotalAr(i, j) = SubTotalAr(i, j) + DataArea(m, 3)
- Next m
-
- With Sheets("總表")
- .Range("B4").Resize(UBound(AllType) + 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
- Sheets("原始資料").Range("m7") = t2 - t1
- MsgBox "耗時" & t2 - t1
- End Sub
|
|
發表於 2013-6-6 23:39
| 
