上一期，我为大家分享了自己弄的公历<---->农历互转的技术与方法一，今天，我们以第二种方法实现这个问题。
好了，我们现在开始实现吧。
一、Excel前端带农历万年历界面设计
关于界面的设计，这里和上次那一期方法一设计的带农历的万年历的界面一样，这里不做过多描述，这里就只以截图直接呈现给各位吧。如下图所示
图1 带农历的万年历界面
二、用方法二实现带农历万年历的功能代码
模块1中代码如下：
'强势自定义“公历”--->“农历”转换函数解决万年历中同时存在公历和农历日期的问题
Public shp_year_select As Shape, y '定义公有全局变量年份选择组合框shp_year_select和用于存储选择的年份变量y，以便所有的过程都可以调用和回传数据
Sub Run_Fill_Calender() '运行填充日历
[b4].Select
n = shp_year_select.ControlFormat.Value
y = shp_year_select.ControlFormat.List(n)
[O1] = y & " 年历" & "[" & Mid(NongLi(y & "-6-1"), 4, 6) & "]"
Fill_Calender_Datas '调用“填充日历数据”过程
[a65535] = y '将选择过的年份存储在单元格"A65535"中
End Sub
Sub Fill_Calender_Datas() '填充日历数据
Dim rg(1 To 12) As Range '定义12个元素的的范围区域对象数组
'为区域对象数组的每个区域对象元素对象指派这12个区域对象具体的实体
Set rg(1) = [b5:h10]: Set rg(2) = [j5:p10]: Set rg(3) = [r5:x10]: Set rg(4) = [z5:af10]
Set rg(5) = [b15:h20]: Set rg(6) = [j15:p20]: Set rg(7) = [r15:x20]: Set rg(8) = [z15:af20]
Set rg(9) = [b25:h30]: Set rg(10) = [j25:p30]: Set rg(11) = [r25:x30]: Set rg(12) = [z25:af30]
For i = 1 To 12
Select Case i
Case 1, 3, 5, 7, 8, 10, 12: days_31 y, i, rg(i)
Case 4, 6, 9, 11: days_30 y, i, rg(i)
Case 2: days_29_Or_28 y, i, rg(i)
End Select
Next
End Sub
Sub Erse_Calender_Datas() '清空日历数据
Dim rg As Range
Set rg = [5:10,15:20,25:30]
[b4].Select
rg.ClearContents
[O1] = "---- 年历[-----年]"
yr = Year(Date)
'以下是定位当今日期的年份在表单组合框中显示
For i = 1 To shp_year_select.ControlFormat.ListCount
If yr = Val(shp_year_select.ControlFormat.List(i)) Then
n = i
Exit For
End If
Next
shp_year_select.ControlFormat.ListIndex = n
End Sub
Sub days_31(y, m, r As Range) '月大--31天
Dim da As Date, d
r.ClearContents
week_str = "日一二三四五六"
d = 1
da = CDate(y & "-" & m & "-" & d) '将字符串动态转换为真正的日期
ws = Mid(Format(da, "[$-804]aaaa"), 3) '从转换为星期XX的字符串中提取大写星期几的汉字保存在ws中
First_Day_Pos_In_Week_Area = InStr(week_str, ws) '每月初始的1号在日历星期区域的定位位置
For d = 1 To 31
da = CDate(y & "-" & m & "-" & d) '将字符串动态转换为真正的日期
ws = Mid(Format(da, "[$-804]aaaa"), 3) '从转换为星期XX的字符串中提取大写星期几的汉字保存在ws中
Other_Day_Pos_In_Week_Area = InStr(week_str, ws)
'实际的每月的号数应该加上每月初始的1号在日历星期区域的定位位置减去1“”d (First_Day_Pos_In_Week_Area - 1)，为了在第7个位置仍然将该号 _
数放在该行，所以还得再减去1“d (First_Day_Pos_In_Week_Area - 1) - 1”，然后再除7取整，同时乘以7后加上该号数在日历中星期区域的实际列数 _
位置，即可得到该号数在日历区域的设计位置
p = Int((d (First_Day_Pos_In_Week_Area - 1) - 1) / 7) * 7 Other_Day_Pos_In_Week_Area
yl_md = Right(NongLi(da), 4) '调用转农历(阴历)函数，取后四个汉字月日日期字符
yl_m = Left(yl_md, 2) '拆解阴历月日中的月份
yl_d = Right(yl_md, 2) '拆解阴历月日中的日子
If yl_d = "初一" Then yl_d = yl_m '若拆解的日子是“初一”，则即刻用该月的月份替代该阴历月份的首个日子
r(p) = d & Chr(10) & yl_d '将公历日期和对应的农历日期合在一起填入到p处正确位置
If da = Date Then r(p).Select '若选择年份后不断瞬时生成的日期da和现在的日期匹配，则将当前填充的日期单元格选择成活动状态
Next
End Sub
Sub days_30(y, m, r As Range) '月小--30天
Dim da As Date, d
r.ClearContents
week_str = "日一二三四五六"
d = 1
da = CDate(y & "-" & m & "-" & d) '将字符串动态转换为真正的日期
ws = Mid(Format(da, "[$-804]aaaa"), 3) '从转换为星期XX的字符串中提取大写星期几的汉字保存在ws中
First_Day_Pos_In_Week_Area = InStr(week_str, ws) '每月初始的1号在日历星期区域的定位位置
For d = 1 To 30
da = CDate(y & "-" & m & "-" & d) '将字符串动态转换为真正的日期
ws = Mid(Format(da, "[$-804]aaaa"), 3) '从转换为星期XX的字符串中提取大写星期几的汉字保存在ws中
Other_Day_Pos_In_Week_Area = InStr(week_str, ws)
'实际的每月的号数应该加上每月初始的1号在日历星期区域的定位位置减去1“”d (First_Day_Pos_In_Week_Area - 1)，为了在第7个位置仍然将该号 _
数放在该行，所以还得再减去1“d (First_Day_Pos_In_Week_Area - 1) - 1”，然后再除7取整，同时乘以7后加上该号数在日历中星期区域的实际列数 _
位置，即可得到该号数在日历区域的设计位置
p = Int((d (First_Day_Pos_In_Week_Area - 1) - 1) / 7) * 7 Other_Day_Pos_In_Week_Area
yl_md = Right(NongLi(da), 4) '调用转农历(阴历)函数，取后四个汉字月日日期字符
yl_m = Left(yl_md, 2) '拆解阴历月日中的月份
yl_d = Right(yl_md, 2) '拆解阴历月日中的日子
If yl_d = "初一" Then yl_d = yl_m '若拆解的日子是“初一”，则即刻用该月的月份替代该阴历月份的首个日子
r(p) = d & Chr(10) & yl_d '将公历日期和对应的农历日期合在一起填入到p处正确位置
If da = Date Then r(p).Select '若选择年份后不断瞬时生成的日期da和现在的日期匹配，则将当前填充的日期单元格选择成活动状态
Next
End Sub
Sub days_29_Or_28(y, m, r As Range) '闰年2月份29天，平年2月份28天(例如2020年就是闰年)
Dim da As Date, d
r.ClearContents
week_str = "日一二三四五六"
d = 1
da = CDate(y & "-" & m & "-" & d) '将字符串动态转换为真正的日期
ws = Mid(Format(da, "[$-804]aaaa"), 3) '从转换为星期XX的字符串中提取大写星期几的汉字保存在ws中
First_Day_Pos_In_Week_Area = InStr(week_str, ws) '每月初始的1号在日历星期区域的定位位置
If Is_LeepYear(y) Then '闰年2月份天数
For d = 1 To 29
da = CDate(y & "-" & m & "-" & d) '将字符串动态转换为真正的日期
ws = Mid(Format(da, "[$-804]aaaa"), 3) '从转换为星期XX的字符串中提取大写星期几的汉字保存在ws中
Other_Day_Pos_In_Week_Area = InStr(week_str, ws)
'实际的每月的号数应该加上每月初始的1号在日历星期区域的定位位置减去1“”d (First_Day_Pos_In_Week_Area - 1)，为了在第7个位置仍然将该 _
号数放在该行，所以还得再减去1“d (First_Day_Pos_In_Week_Area - 1) - 1”，然后再除7取整，同时乘以7后加上该号数在日历中星期区域的实 _
际列数位置，即可得到该号数在日历区域的设计位置
p = Int((d (First_Day_Pos_In_Week_Area - 1) - 1) / 7) * 7 Other_Day_Pos_In_Week_Area
yl_md = Right(NongLi(da), 4) '调用转农历(阴历)函数，取后四个汉字月日日期字符
yl_m = Left(yl_md, 2) '拆解阴历月日中的月份
yl_d = Right(yl_md, 2) '拆解阴历月日中的日子
If yl_d = "初一" Then yl_d = yl_m '若拆解的日子是“初一”，则即刻用该月的月份替代该阴历月份的首个日子
r(p) = d & Chr(10) & yl_d '将公历日期和对应的农历日期合在一起填入到p处正确位置
If da = Date Then r(p).Select '若选择年份后不断瞬时生成的日期da和现在的日期匹配，则将当前填充的日期单元格选择成活动状态
Next
Else '平年2月份天数
For d = 1 To 28
da = CDate(y & "-" & m & "-" & d) '将字符串动态转换为真正的日期
ws = Mid(Format(da, "[$-804]aaaa"), 3) '从转换为星期XX的字符串中提取大写星期几的汉字保存在ws中
Other_Day_Pos_In_Week_Area = InStr(week_str, ws)
'实际的每月的号数应该加上每月初始的1号在日历星期区域的定位位置减去1“”d (First_Day_Pos_In_Week_Area - 1)，为了在第7个位置仍然将该 _
号数放在该行，所以还得再减去1“d (First_Day_Pos_In_Week_Area - 1) - 1”，然后再除7取整，同时乘以7后加上该号数在日历中星期区域的实 _
际列数位置，即可得到该号数在日历区域的设计位置
p = Int((d (First_Day_Pos_In_Week_Area - 1) - 1) / 7) * 7 Other_Day_Pos_In_Week_Area
yl_md = Right(NongLi(da), 4) '调用转农历(阴历)函数，取后四个汉字月日日期字符
yl_m = Left(yl_md, 2) '拆解阴历月日中的月份
yl_d = Right(yl_md, 2) '拆解阴历月日中的日子
If yl_d = "初一" Then yl_d = yl_m '若拆解的日子是“初一”，则即刻用该月的月份替代该阴历月份的首个日子
r(p) = d & Chr(10) & yl_d '将公历日期和对应的农历日期合在一起填入到p处正确位置
If da = Date Then r(p).Select '若选择年份后不断瞬时生成的日期da和现在的日期匹配，则将当前填充的日期单元格选择成活动状态
Next
End If
End Sub
Function Is_LeepYear(y) As Boolean '给定的年份是否为闰年LeepYear的判断
If (y Mod 400 = 0) Or (y Mod 100 <> 0 And y Mod 4 = 0) Then
Is_LeepYear = True
Else
Is_LeepYear = False
End If
End Function
'自定义“公历转农历”日期函数
Public Function NongLi(Optional XX_DATE As Date)
Dim MonthAdd(11), NongliData(99), TianGan(9), DiZhi(11), ShuXiang(11), DayName(30), MonName(12)
Dim curTime, curYear, curMonth, curDay
Dim GongliStr, NongliStr, NongliDayStr
Dim i, m, n, k, isEnd, bit, TheDate
'获取当前系统时间
curTime = XX_DATE
'天干名称
TianGan(0) = "甲": TianGan(1) = "乙": TianGan(2) = "丙": TianGan(3) = "丁": TianGan(4) = "戊": TianGan(5) = "己"
TianGan(6) = "庚": TianGan(7) = "辛": TianGan(8) = "壬": TianGan(9) = "癸"
'地支名称
DiZhi(0) = "子": DiZhi(1) = "丑": DiZhi(2) = "寅": DiZhi(3) = "卯": DiZhi(4) = "辰": DiZhi(5) = "巳": DiZhi(6) = "午"
DiZhi(7) = "未": DiZhi(8) = "申": DiZhi(9) = "酉": DiZhi(10) = "戌": DiZhi(11) = "亥"
'属相名称
ShuXiang(0) = "鼠": ShuXiang(1) = "牛": ShuXiang(2) = "虎": ShuXiang(3) = "兔": ShuXiang(4) = "龙": ShuXiang(5) = "蛇"
ShuXiang(6) = "马": ShuXiang(7) = "羊": ShuXiang(8) = "猴": ShuXiang(9) = "鸡": ShuXiang(10) = "狗": ShuXiang(11) = "猪"
'农历日期名
DayName(0) = "*": DayName(1) = "初一": DayName(2) = "初二": DayName(3) = "初三": DayName(4) = "初四": DayName(5) = "初五"
DayName(6) = "初六": DayName(7) = "初七": DayName(8) = "初八": DayName(9) = "初九": DayName(10) = "初十": DayName(11) = "十一"
DayName(12) = "十二": DayName(13) = "十三": DayName(14) = "十四": DayName(15) = "十五": DayName(16) = "十六": DayName(17) = "十七"
DayName(18) = "十八": DayName(19) = "十九": DayName(20) = "二十": DayName(21) = "廿一": DayName(22) = "廿二"
DayName(23) = "廿三": DayName(24) = "廿四": DayName(25) = "廿五": DayName(26) = "廿六": DayName(27) = "廿七"
DayName(28) = "廿八": DayName(29) = "廿九": DayName(30) = "三十"
'农历月份名
MonName(0) = "*": MonName(1) = "正": MonName(2) = "二": MonName(3) = "三": MonName(4) = "四": MonName(5) = "五"
MonName(6) = "六": MonName(7) = "七": MonName(8) = "八": MonName(9) = "九": MonName(10) = "十": MonName(11) = "冬"
MonName(12) = "腊"
'公历每月前面的天数(在这里，MonthAdd(0)代表的是1月前面的天数、MonthAdd(1)代表的是2月前面的天数、、MonthAdd(2)代表的是3月 _
前面的天数等等)
MonthAdd(0) = 0: MonthAdd(1) = 31: MonthAdd(2) = 59: MonthAdd(3) = 90: MonthAdd(4) = 120: MonthAdd(5) = 151
MonthAdd(6) = 181: MonthAdd(7) = 212: MonthAdd(8) = 243: MonthAdd(9) = 273: MonthAdd(10) = 304: MonthAdd(11) = 334
'农历数据(NongliData保存了从1921年（NongliData(0)）以来到2021年（NongliData(99)）这100年的农历数据)。必须说明下这些数据 _
的含义，比如NongliData(0)=2635是1921年的数据，二进制是101001001011，这12位二进制的各位，分别对应农历的12个月：从左往右的 _
第一位是1，那么1921年正月是30天；第二位是0，那么1921年二月是29天；第三位是1，那么1921年三月是30天；第四位是0，那么1921年 _
四月是29天......以此类推。这些数据不是通过某种算法算出来的，而是根据以1921年作为基准情况下从1921年～2021年这100年的每年的 _
农历1～12个月中各月的天数在30或者29跳变情况而形成的12位或13位二进制(考虑到有可能某些年份要闰月的情况) 闰月的信息二进制形成 _
的序列，由这个序列再形成简化的十进制。 _
下面，我们举个例子详细说明下：在下面的NongliData上，我们会发现有很多大于4095的数值，比如1922年是NongliData(1)=333387，二 _
进制是1010001011001001011，1922年农历有13个月（包括农历闰月），去掉头101000，1011001001011是13个月份数据，而闰几月 _
就在101000中保存，删掉后3个0，101就是1922年闰月的月份，101是十进制的5。至于中间的三个零是为了编程的时候好对齐才多出来的。 _
多亏了网上的好心人总结出来了，我们才得以方便使用这些又原12位的二进制转化为简化的十进制各年农历数据
NongliData(0) = 2635: NongliData(1) = 333387: NongliData(2) = 1701: NongliData(3) = 1748: NongliData(4) = 267701
NongliData(5) = 694: NongliData(6) = 2391: NongliData(7) = 133423: NongliData(8) = 1175: NongliData(9) = 396438
NongliData(10) = 3402: NongliData(11) = 3749: NongliData(12) = 331177: NongliData(13) = 1453: NongliData(14) = 694
NongliData(15) = 201326: NongliData(16) = 2350: NongliData(17) = 465197: NongliData(18) = 3221: NongliData(19) = 3402
NongliData(20) = 400202: NongliData(21) = 2901: NongliData(22) = 1386: NongliData(23) = 267611: NongliData(24) = 605
NongliData(25) = 2349: NongliData(26) = 137515: NongliData(27) = 2709: NongliData(28) = 464533: NongliData(29) = 1738
NongliData(30) = 2901: NongliData(31) = 330421: NongliData(32) = 1242: NongliData(33) = 2651: NongliData(34) = 199255
NongliData(35) = 1323: NongliData(36) = 529706: NongliData(37) = 3733: NongliData(38) = 1706: NongliData(39) = 398762
NongliData(40) = 2741: NongliData(41) = 1206: NongliData(42) = 267438: NongliData(43) = 2647: NongliData(44) = 1318
NongliData(45) = 204070: NongliData(46) = 3477: NongliData(47) = 461653: NongliData(48) = 1386: NongliData(49) = 2413
NongliData(50) = 330077: NongliData(51) = 1197: NongliData(52) = 2637: NongliData(53) = 268877: NongliData(54) = 3365
NongliData(55) = 531109: NongliData(56) = 2900: NongliData(57) = 2922: NongliData(58) = 398042: NongliData(59) = 2395
NongliData(60) = 1179: NongliData(61) = 267415: NongliData(62) = 2635: NongliData(63) = 661067: NongliData(64) = 1701
NongliData(65) = 1748: NongliData(66) = 398772: NongliData(67) = 2742: NongliData(68) = 2391: NongliData(69) = 330031
NongliData(70) = 1175: NongliData(71) = 1611: NongliData(72) = 200010: NongliData(73) = 3749: NongliData(74) = 527717
NongliData(75) = 1452: NongliData(76) = 2742: NongliData(77) = 332397: NongliData(78) = 2350: NongliData(79) = 3222
NongliData(80) = 268949: NongliData(81) = 3402: NongliData(82) = 3493: NongliData(83) = 133973: NongliData(84) = 1386
NongliData(85) = 464219: NongliData(86) = 605: NongliData(87) = 2349: NongliData(88) = 334123: NongliData(89) = 2709
NongliData(90) = 2890: NongliData(91) = 267946: NongliData(92) = 2773: NongliData(93) = 592565: NongliData(94) = 1210
NongliData(95) = 2651: NongliData(96) = 395863: NongliData(97) = 1323: NongliData(98) = 2707: NongliData(99) = 265877
'生成当前公历年、月、日 ==> GongliStr
curYear = Year(curTime)
curMonth = Month(curTime)
curDay = Day(curTime)
GongliStr = curYear & "年"
If (curMonth < 10) Then '判断当前月是否小于10月，如果小于10月的话，当前月的位数应该补零占位，形式上形成两位的月份
GongliStr = GongliStr & "0" & curMonth & "月"
Else '否则，当前月大于等于10，就直接形成两位的月份
GongliStr = GongliStr & curMonth & "月"
End If
If (curDay < 10) Then '判断当前日子是否小于10日，如果小于10日的话，当前日子的位数应该补零占位，形式上形成两位的日子
GongliStr = GongliStr & "0" & curDay & "日"
Else '否则，当前日子大于等于10，就直接形成两位的日子
GongliStr = GongliStr & curDay & "日"
End If
'用日期差函数返回相差天数的形式计算到初始时间1921年2月8日的天数：1921-2-8(正月初一)
If curTime >= CDate("1921-2-8") And curTime <= CDate("2021-2-8") Then
TheDate = DateDiff("d", CDate("1921-2-8"), curTime) 1
Else
NongLi = ""
Exit Function
End If
If ((curYear Mod 4) = 0 And curMonth > 2) Then
TheDate = TheDate 1
End If
'计算农历天干、地支、月、日
isEnd = 0 '是否结束，为1表示结束，为0表示未结束
m = 0
Do
If (NongliData(m) < 4095) Then '以农历数据为4095这个农历年份为基准判断当前年份相比之下农历数据换算成二进制位数是否 _
低于12位的情况
k = 11 '小于4095，则该年份的农历数据换算成二进制数11位(不足12位)
Else
k = 12 '大于等于4095，则该年份的农历数据换算成二进制数12位(满满的12位)
End If
n = k
Do
If (n < 0) Then
Exit Do
End If
'获取NongliData(m)的第n个二进制位的值
bit = NongliData(m)
For i = 1 To n Step 1
bit = Int(bit / 2) '辗转除2取整
Next
bit = bit Mod 2 '除2取余
If (TheDate <= 29 bit) Then '日期差的天数都严重小于等于(29 bit)天，则立即置结束标志isEnd为1，并退出Do循环
isEnd = 1
Exit Do
End If
TheDate = TheDate - 29 - bit '修正日期差天数
n = n - 1 '遍历操作一次获取每位二进制位值，n修正一次自身(自减一次)
Loop
If (isEnd = 1) Then
Exit Do
End If
m = m 1 'm为农历数据数组的下标，每循环一次，增加一次，轮转到下一年份的农历数据准备处理
Loop
'修正当前的年、月、日
curYear = 1921 m
curMonth = k - n 1
curDay = TheDate
'如果该年份的农历数据对应的二进制位数为12位，则进一步做如下处理
If (k = 12) Then
If (curMonth = (Int(NongliData(m) / 65536) 1)) Then 'If (curMonth=(Int(NongliData(m)/65536) 1))润 _
几月的问题，比如1922年年份的农历数据是333387，由333387/65536取整得5，表达1922年是闰5月
curMonth = 1 - curMonth '修正当前月
ElseIf (curMonth > (Int(NongliData(m) / 65536) 1)) Then
curMonth = curMonth - 1 '修正当前月
End If
End If
'生成农历天干、地支、属相 ==> NongliStr
NongliStr = "农历" & TianGan(((curYear - 4) Mod 60) Mod 10) & DiZhi(((curYear - 4) Mod 60) Mod 12) & "年"
NongliStr = NongliStr & "(" & ShuXiang(((curYear - 4) Mod 60) Mod 12) & ")"
'生成农历月、日 ==> NongliDayStr
If (curMonth < 1) Then
NongliDayStr = "闰" & MonName(-1 * curMonth)
Else
NongliDayStr = MonName(curMonth)
End If
NongliDayStr = NongliDayStr & "月"
NongliDayStr = NongliDayStr & DayName(curDay)
NongLi = NongliStr & NongliDayStr
End Function
ThisWorkbook中代码如下：
Private Sub Workbook_Open() '工作簿一打开即刻初始化表单组合框数据并且在组合框中显示之前选择过的年份
Set shp_year_select = Sheets(1).Shapes("年份选择")
shp_year_select.ControlFormat.RemoveAllItems
'万年历的年份范围初步设定为“1900～9999”
For i = 1921 To 2021
shp_year_select.ControlFormat.AddItem i
Next
'以下是重新还原表单组合框控件之前选定过的年份显示
yr = [a65535]
For i = 1 To shp_year_select.ControlFormat.ListCount
If yr = Val(shp_year_select.ControlFormat.List(i)) Then
n = i '遍历整个表单组合框所有元素，查找与yr是否相匹配的元素，若找到即刻记下该编号并存于n中
Exit For
End If
Next
shp_year_select.ControlFormat.ListIndex = n '让表单组合框显示找到的之前选择过的年份
End Sub
三、用方法二实现带农历万年历运行效果测试
(一)选择年份，呈待生成带农历万年历状态。如下图所示
图2 选择年份准备生成带农历万年历
(二)点击选择的年份，生成实实在在的带农历的万年历。如下图所示
图3 生成带农历万年历效果
(三)压下<清除日历数据>按钮，准备进行带农历的万年历数据清除。如下图所示
图4 准备清除带农历万年历数据
(四)压下状态下的<清除日历数据>按钮情况下点击该按钮，完成带农历万年历数据的清除，并将年份组合框内的显示提示年份置为最新当前时间的年份。如下图所示
图5 清除带农历万年历数据结果
四、技术亮点小结
(一)同样是充分利用寻找农历闰月方法和压缩的农历字符还原方法完成公历转农历
(二)同样是在定位Excel的万年历数据填充单元格时，用字符串处理函数处理农历生成的数据
好了，本期我们就分享到这里吧，希望大家喜欢和收藏哦！
最后，还是感谢大家的持续关注(头条号：跟我学Office高级办公)、推广、点评哦！谢谢大家继续关注下期第二中方法实现带农历的万年历设计！
