Sub 生成年历()
y = InputBox("请指定一个年份:")
'清除原有内容
Range("1:1, 4:11,14:21,24:31,34:41").ClearContents
'设置标题
Cells(1, 1) = y & "年历"
Dim dm As Variant
'dm 下标从0开始
dm = Array(31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31)
'处理闰年,修正二月份天数
If ((y Mod 400 = 0) Or (y Mod 4 = 0 And y Mod 100 <> 0)) Then
dm(1) = 29
End If
For m = 0 To 11
'计算每月第一天的星期数(1日,2一,3二...)
d = DateSerial(y, m + 1, 1)
w = Weekday(d)
'计算每月起始的行号和列号
r = (m \ 3) * 10 + 4
c = (m Mod 3) * 8
'排出一个月的日期
For d = 1 To dm(m)
Cells(r, c + w) = d
w = w + 1
If w > 7 Then
w = 1
r = r + 1
End If
Next
Next
End Sub