在数据统计分析中经常用到日历表，也有很多方法创建日历表，例如如下几篇博客分享如何使用Power Query创建日历表（相关链接参见本博文的最后部分）。

本次将要分享如何使用VBA创建如下格式的日历表，需要注意的是周次列，其中第x周的计算需要一些技巧。

示例代码如下。

Sub Demo()
    Dim i As Long, arrRes(), dDate As Date
    Dim iWeek As Long, sMthWeek As String
    Dim dDate1 As Date, iWeekOffset As Long
    Const DAY_CNT = 366
    ReDim arrRes(1 To DAY_CNT, 1 To 3)
    dDate = #1/1/2023#
    For i = 1 To DAY_CNT
        dDate = dDate + 1
        If Year(dDate) > Year(Date) Then Exit For
        dDate1 = DateSerial(Year(dDate), Month(dDate), 1)
        iWeek = DatePart("ww", dDate, vbMonday) - DatePart("ww", dDate1, vbMonday)
        If DatePart("w", dDate1) = vbMonday Then iWeekOffset = 1 Else iWeekOffset = 0
        iWeek = iWeek + iWeekOffset
        If iWeek <> 0 Then sMthWeek = Month(dDate) & "月第" & iWeek & "周"
        arrRes(i, 1) = sMthWeek
        arrRes(i, 2) = Format(dDate, "yyyy年MM月dd日")
        arrRes(i, 3) = Format(dDate, "aaaa")
    Next i
    Range("A:C").ClearContents
    Range("A1:C1").Value = Array("周次", "日期", "星期")
    Range("A2").Resize(DAY_CNT, 3) = arrRes
End Sub

【代码解析】
第7行代码设置起始日期，创建的日历表从其之后一天开始。
第8~19行代码循环处理每个日期。
第9行代码日期加一递增。
第10行代码判断日期变量是否已经跨年，本需要只创建2023的日历表。
第11行代码获取当月第一天（dDate1）的日期值。
第12行代码获取当前日期的周数和当月第一天的周数差值。
如果当月第一天为周一，第13行代码设置iWeekOffset为以1，否则设置为0。设置这个周数偏移量的原因是，如果满足条件，iWeek值将为0，那么该月的周数将都错误，因此需要增加一个偏移量。
第14行代码调整周数iWeek。
第16~18行代码按照指定格式创建数据。
第20行代码清空输出区域。
第21行代码设置输出表头。
第23行代码将数据表写入单元格。

相关文章链接如下：
PQ制作时间维度表（1）
PQ制作时间维度表（2）
PQ制作时间维度表（3）
PQ制作时间维度表（4）
PQ制作时间维度表（5）
PQ制作时间维度表（6）
PQ制作时间维度表（7）