Option Explicit
Sub TEST()
Dim Crr(1 To 2, 1 To 32), D As Date, Z, A, C%, T$, T1$, T2$, T3$
[B2].Resize(5, 15).ClearContents
Set Z = CreateObject("Scripting.Dictionary")
D = Year(Date) & "/" & Val([A4]) & "/15"
Set Z("一") = CreateObject("Scripting.Dictionary")
Z("一")("A") = Crr: Set Z("三") = Z("一"): Set Z("六") = Z("一")
Set Z("日") = CreateObject("Scripting.Dictionary")
Z("日")("A") = Crr: Set Z("二") = Z("日"): Set Z("四") = Z("日")
For D = DateSerial(Year(D), Month(D), 1) To DateSerial(Year(D), Month(D) + 1, 0)
T = Right(Format(D, "[DBNum1]aaa"), 1)
If Not Z.Exists(T) Then GoTo d01
A = Z(T)("A")
C = A(1, 32) + 1
A(1, 32) = C
A(1, C) = Format(D, "d")
A(2, C) = T
Z(T)("A") = A
d01: Next
[B2].Resize(2, Z("一")("A")(1, 32)) = Z("一")("A")
[B5].Resize(2, Z("日")("A")(1, 32)) = Z("日")("A")
End Sub
Sub TEST_1()
Dim X, Y, Z
Set Z = CreateObject("Scripting.Dictionary")
Set Y = Z
Set X = Z
X("A") = 1000
MsgBox "Y(""A"") =" & Y("A")
MsgBox "Z(""A"") =" & Z("A")
End Sub
