Option Explicit
Sub TEST()
Dim Brr, T, Y, Z, A, xR As Range
'↑宣告變數:(Brr,T,Y,Z,A)是通用型變數,(xR,xU)是儲存格變數
Set Y = CreateObject("Scripting.Dictionary")
'↑令Y這通用型變數是 字典
Set Z = CreateObject("System.Collections.ArrayList")
'↑令Z這通用型變數是 使用大小會視需要動態增加的陣列
Set xR = [A1:F9]: Brr = xR
'↑令xR這儲存格變數是 [A1:F9]儲存格,
'令Brr這通用型變數是 二維陣列,以xR變數儲存格值帶入陣列裡
For Each A In Brr
'↑設逐項迴圈!令A這通用型變數是 Brr陣列裡的一個陣列值
A = Format(A, "yyyy" & "年" & "mm")
'↑令A變數是 四位數的數字碼年 連接"年",再連接2碼月份成的新字串
If A <> vbNullString And Not Z.contains(A) Then Z.Add (A)
'↑如果A變數不是 長度為零的字串,而且A變數不在Z陣列裡?
'如果條件成立就把 A變數納入Z陣列裡
Next
Z.Sort
'↑令Z陣列做順排序
For Each A In Z: Y(A) = 0: Next
'↑設逐項迴圈!將Z陣列裡的值當key,item是0,納入Y字典裡
For Each A In xR
'↑設逐項迴圈!令A變數是xR變數儲存格中的一格
A = Format(A, "yyyy" & "年" & "mm")
'↑令A變數是 四位數的數字碼年 連接"年",再連接2碼月份成的新字串
Y(A) = Y(A) + 1
'↑令A變數值轉數值當key,item是 item自身值+1
Next
[L:M].ClearContents: [L1:M1] = [{"月份", "天數"}]
'↑令[L:M]儲存格清除內容:令[L1:M1]這兩格以↑陣列兩字串帶入
[L2].Resize(Y.Count, 1) = Application.Transpose(Y.keys)
'↑令[L2]擴展向下Y字典key數量數的儲存格,
'以Y字典keys轉置後帶入儲存格
[M2].Resize(Y.Count, 1) = Application.Transpose(Y.items)
'↑令[M2]擴展向下Y字典key數量數的儲存格,
'以Y字典items轉置後帶入儲存格
Set Y = Nothing: Set Z = Nothing: Set xR = Nothing
Erase Brr
'↑令釋放變數
End Sub作者: hcm19522 時間: 2023-3-24 11:25