Option Explicit
Sub TEST()
Dim Brr, Crr, Z, i&, R&, Y$, N&, J&, V&, T$, xA As Range
'↑宣告變數
Set Z = CreateObject("Scripting.Dictionary")
'↑令Z變數是 字典
Set xA = Range([H1], [A65536].End(3)): Brr = xA
'↑令xA變數是 指定範圍儲存格(物件),令Brr變數是寫入xA變數(儲存格)值的二維陣列
ReDim Crr(1 To 1000, 1 To 3)
'↑宣告Crr變數是 二維空陣列,索引號~1000列,1~3欄
For i = 2 To UBound(Brr)
'↑設順迴圈!i從2 到Brr陣列縱向最大索引列號
Y = Format(Brr(i, 1), "YYYY"): If Y = "" Then GoTo i01 Else R = Z(Y)
'↑令Y變數是日期的4碼年份字串,如果Y變數是 空字元,就跳到標示 i01位置繼續執行,
'否則就令R變數是以Y變數查Z字典回傳item值
If R = 0 Then N = N + 1: R = N: Z(Y) = R: Brr(R, 1) = Y: Brr(R, 2) = "年度小計": Brr(R, 3) = 0
'↑如果此年分是首次納入Z字典!就令N累積Brr陣列放結果列數,
'以年分為key,item是列號,納入Z字典,
'令Brr陣列結果列第2欄陣列值是 "年度小計"字串,令原來Brr陣列資料值設為0
Brr(R, 3) = Brr(R, 3) + Val(Brr(i, 8))
'↑令Brr陣列結果列第3欄累加 金額
T = Trim(Brr(i, 3)): If T = "" Then GoTo i01 Else V = Z(T)
'↑令T變數是 股票名稱字串,如果T變數是 空字元,就跳到標示 i01位置繼續執行,
'否則就令V變數是以T變數查Z字典回傳item值
If V = 0 Then J = J + 1: V = J: Z(T) = V: Crr(V, 1) = T: Crr(V, 2) = "歷史總計"
'↑如果股票名稱是首次納入Z字典!就令J累積Crr陣列放結果列數,
'以股票名稱為key,item是列號,納入Z字典,
'令Crr陣列結果列第2欄陣列值是 "歷史總計"字串
Crr(V, 3) = Crr(V, 3) + Val(Brr(i, 8))
'↑令Crr陣列結果列第3欄累加 金額
i01: Next
ActiveSheet.UsedRange.Offset(xA.Rows.Count).ClearContents
'↑令舊的結果列清除內容
If N = 0 Then Exit Sub
'↑如果年分統計沒有資料!就結束程式執行
xA(xA.Count + 6).Resize(N, 3) = Brr
'↑令年分統計資料寫入儲存格
If J = 0 Then Exit Sub
'↑如果股票名稱歷史總計沒有資料!就結束程式執行
[A65536].End(3)(N + 3, 6).Resize(J, 3) = Crr
'↑令股票名稱歷史總計統計資料寫入儲存格
End Sub
