- 帖子
- 1446
- 主題
- 40
- 精華
- 0
- 積分
- 1470
- 點名
- 0
- 作業系統
- Windows 7
- 軟體版本
- Excel 2010 & 2016
- 閱讀權限
- 50
- 性別
- 男
- 來自
- 台灣
- 註冊時間
- 2020-7-15
- 最後登錄
- 2024-10-21
|
7#
發表於 2023-12-12 09:44
| 只看該作者
謝謝論壇,謝謝各位前輩
後學藉此帖練習陣列與字典,學習方案如下,請各位前輩指教
執行前:
執行結果:
Option Explicit
Sub TEST()
Dim Brr, Crr, Z, i&, R&, C%, N&, X%, T$, Dx As Date
Set Z = CreateObject("Scripting.Dictionary")
Brr = Range([C2], [A65536].End(xlUp))
ReDim Crr(1000, 1000)
For i = 1 To UBound(Brr)
Dx = Format(Brr(i, 1), "YY/MM/01"): R = Z(Dx)
T = Trim(Brr(i, 2)): C = Z(T)
If R = 0 Then N = N + 1: R = N: Z(Dx) = R: Crr(R, 0) = Dx
If C = 0 Then X = X + 1: C = X: Z(T) = C: Crr(0, C) = T
Crr(R, C) = Crr(R, C) + Brr(i, 3)
Next
T = [E1]: [E:Z].Clear: [E1] = T: [E1].HorizontalAlignment = xlCenter
With [E1].Resize(1, X + 2): .Merge: .Borders.LineStyle = 1: End With
If N * X = 0 Then Exit Sub
With [E2].Resize(N + 1, X + 2)
.Value = Crr
.Offset(0, 1).Sort KEY1:=.Item(1), Order1:=1, Header:=2, Orientation:=2
.Offset(1, 0).Sort KEY1:=.Item(1), Order1:=1, Header:=2, Orientation:=1
.Columns(1).NumberFormatLocal = "m""月"""
.Borders.LineStyle = 1
.Columns(X + 2) = "=SUM(F2:" & Cells(2, X + 5).Address(0, 0) & ")"
.Cells(1, 1) = "種類": .Cells(1, X + 2) = "總計"
End With
End Sub |
|
發表於 2014-6-1 18:32
| 
