你好。 在之前的作品中，我们用Excel实现了万年历的制作，当时也有很多网友看到过我的那个头条报道和头条视频。 附有评价和收藏。 在此感谢。

另外，一位名叫“斑丽虎zcy”的粉丝评论说，如果我做的万年历中包含农历就完美了。 我欣然接受了这个粉丝的建议。 另外，虽然没有采用“斑丽虎zcy”粉丝提供的公历过渡到农历的关键技术模板，但我们深深感谢“斑丽虎zcy”粉丝的热心。

上次，我向大家分享了自己创造的公元——农历互转的技术和方法。 另外，很多网友看到这次的头条和视频，表示大家对这个方法也非常认可。 非常感谢。 从今以后，我打算用两种阳历——农历互转的方法来实现带农历的万年历的设计。 为了区别，我们暂定本期的主题为“头条---用excel设计农历万年历的方法1”，下期作品的主题为“头条---用excel设计农历万年历的方法2”。

本期，首先用第一种方法来实现吧。

一. Excel前端有农历万年历界面设计

关于界面的设计，这里和上次万年历的界面一样，这里就不多讲了。 这里我们只用截图直接给大家看看吧。 如下图所示

图1农历万年历界面

二、方法一实现农历万年历功能码

模块1的代码如下所示。

&amp； #039； 强势定制“公历”----“农历”互转函数

&amp； #039； 原创：互联网

(修正)今日头条作者《向我学习Office高级办公APP应用》/10/12

&amp； #039； ----农历数据定义-----

&amp； #039； 首先，使用Hexadecimal_To_Binary函数返回长度字符串。 其定义如下。

&amp； #039； 前12个字节1-12月： 1表示大月，0表示小月； 压缩成十六进制(1-3位)

&amp； #039； 第13位是闰月时，1是大月30日，0是小月29日； (4位) )。

&amp； #039； 第14位是闰月的月亮，如果不是闰月就出0，否则出月亮(第5位)

&amp； #039； 最后四个人是当年农历新年的公历日期，例如0131表示1月31日； 转十六进制(6-7位)作为数值

&amp； #039； 定义下一个农历(农历)的日期常数(1899 ) 2100，共计202年，但实际上只需1900(2100 ) 201年即可。)

privateconstyldata=&amp； #039； ab 500 d 2，4bd 0883，&amp； #039； _

&amp； #039； 4AE00DB、a 5700 d 0、54d 0581、D2600D8、D9500CC、655147D、56a 00 d 5、9ad 00 ca、55D027A、4AE00D2、&amp； #039； _

&amp； #039； A5B0682、A4D00DA、D2500CE、D25157E、b 5500 d 6、56 a 00 cc、ADA027B、95 b 00 d 3、49717 C9、49 b 00 DC、&amp； #039； u

&amp； #039； A4B00D0、b4b 0580、6a 500 D8、6d 400 CD、AB5147C、2b 600 D5、95700 ca、52F027B、49700 D2、6560682和&amp； #039； u

&amp； #039； D4A00D9、EA500CE、6A9157E、5a d00 d 6、2b 600 cc、86E137C、92E00D3、C8D1783、C9500DB、D4A00D0、&amp； #039； _

&amp； #039； D8A167F、b 5500 d 7、56 a 00 CD、A5B147D、25 d 00 d 5、92 d 00 ca、D2B027A、A9500D2、b 550781、6ca 00 d 9、&amp； #039； u

&amp； #039； B5500CE、535157F、4DA00D6、A5B00CB、457037C、52B00D4、A9A0883、E9500DA、6AA00D0、AEA0680、&amp； #039； _

&amp； #039； ab 500 d 7、4b 600 CD、AAE047D、a 5700 d 5、52600 ca、F260379、d 9500 d 1、5b 50782、56 a 00 d 9、96 d 00 ce、&amp； #039； u

&amp； #039； 4DD057F、4AD00D7、A4D00CB、D4D047B、D2500D3、D550883、B5400DA、B6A00CF、95a 1680、95 b 00 d 8、&amp； #039； \u

&amp； #039； 49B00CD、A97047D、A4B00D5、B270ACA、6A500DC、6D400D1、AF40681、ab 600 d 9、93700 ce、4AF057F、&amp； #039； u

&amp； #039； 49700 D7、64 b 00 cc、74A037B、ea 500 D2、6b 50883、5a c00 db、AB600CF、96d 0580、92e 00 D8、C9600CD、&amp； #039； u

&amp； #039； D95047C、D4A00D4、da 500 c 9、755027 a和56A0

0D1,ABB0781,25D00DA,92D00CF,CAB057E,A9500D6," _

 & "B4A00CB,BAA047B,B5500D2,55D0983,4BA00DB,A5B00D0,5171680,52B00D8,A9300CD,795047D," _

 & "6AA00D4,AD500C9,5B5027A,4B600D2,96E0681,A4E00D9,D2600CE,EA6057E,D5300D5,5AA00CB," _

 & "76A037B,96D00D3,4AB0B83,4AD00DB,A4D00D0,D0B1680,D2500D7,D5200CC,DD4057C,B5A00D4," _

 & "56D00C9,55B027A,49B00D2,A570782,A4B00D9,AA500CE,B25157E,6D200D6,ADA00CA,4B6137B," _

 & "93700D3,49F08C9,49700DB,64B00D0,68A1680,EA500D7,6AA00CC,A6C147C,AAE00D4,92E00CA," _

 & "D2E0379,C9600D1,D550781,D4A00D9,DA400CD,5D5057E,56A00D6,A6C00CB,55D047B,52D00D3," _

 & "A9B0883,A9500DB,B4A00CF,B6A067F,AD500D7,55A00CD,ABA047C,A5A00D4,52B00CA,B27037A," _

 & "69300D1,7330781,6AA00D9,AD500CE,4B5157E,4B600D6,A5700CB,54E047C,D1600D2,E960882," _

 & "D5200DA,DAA00CF,6AA167F,56D00D7,4AE00CD,A9D047D,A2D00D4,D1500C9,F250279,D5200D1"

'定义农历 (阴历)每月的汉字大写日期“天”

Private Const ylMd0 = "初一初二初三初四初五初六初七初八初九初十十一十二十三十四十五" _

& "十六十七十八十九二十廿一廿二廿三廿四廿五廿六廿七廿八廿九三十 "

'定义农历 (阴历)一年中的汉字大写日期“月”

Private Const ylMn0 = "正二三四五六七八九十冬腊"

'定义农历 (阴历)年中的“天干”(如：甲乙丙丁......等)

Private Const ylTianGan0 = "甲乙丙丁戊已庚辛壬癸"

'定义农历 (阴历)年中的“地支”(如：子丑寅卯辰......等)

Private Const ylDiZhi0 = "子丑寅卯辰巳午未申酉戌亥"

'定义农历 (阴历)年中的“属相”(如：鼠牛虎兔龙......等)

Private Const ylShu0 = "鼠牛虎兔龙蛇马羊猴鸡狗猪"

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(GetYLDate(y & "-6-1"),𔀢,𔀤) & "]"

 Fill_Calender_Datas '调用“填充日历数据”过程

 [a65535] = y '将选择过的年份存储在单元格"A65535"中

End Sub

Sub Fill_Calender_Datas() '填充日历数据

 Dim rg(1 To󈄸) 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 =𔀟 To󈄸

 Select Case i

 Case𔀟,𔀡,𔀣,𔀥,𔀦,󈄶,󈄸: days_31 y, i, rg(i)

 Case𔀢,𔀤,𔀧,󈄷: days_30 y, i, rg(i)

 Case𔀠: 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 =𔀟 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 =𔀟

 da = CDate(y & "-" & m & "-" & d) '将字符串动态转换为真正的日期

 ws = Mid(Format(da, "[$-804]aaaa"),𔀡) '从转换为星期XX的字符串中提取大写星期几的汉字保存在ws中

 First_Day_Pos_In_Week_Area = InStr(week_str, ws) '每月初始的1号在日历星期区域的定位位置

 For d =𔀟 To󈅋

 da = CDate(y & "-" & m & "-" & d) '将字符串动态转换为真正的日期

 ws = Mid(Format(da, "[$-804]aaaa"),𔀡) '从转换为星期XX的字符串中提取大写星期几的汉字保存在ws中

 Other_Day_Pos_In_Week_Area = InStr(week_str, ws)

 '实际的每月的号数应该加上每月初始的1号在日历星期区域的定位位置减去1“”d + (First_Day_Pos_In_Week_Area -𔀟)，为了在第7个位置仍然将该号 _

 数放在该行，所以还得再减去1“d + (First_Day_Pos_In_Week_Area -𔀟) -𔀟”，然后再除7取整，同时乘以7后加上该号数在日历中星期区域的实际列数 _

 位置，即可得到该号数在日历区域的设计位置

 p = Int((d + (First_Day_Pos_In_Week_Area -𔀟) -𔀟) /𔀥) *𔀥 + Other_Day_Pos_In_Week_Area

 yl_md = Right(GetYLDate(da),𔀢) '调用转农历(阴历)函数，取后四个汉字月日日期字符

 yl_m = Left(yl_md,𔀠) '拆解阴历月日中的月份

 yl_d = Right(yl_md,𔀠) '拆解阴历月日中的日子

 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 =𔀟

 da = CDate(y & "-" & m & "-" & d) '将字符串动态转换为真正的日期

 ws = Mid(Format(da, "[$-804]aaaa"),𔀡) '从转换为星期XX的字符串中提取大写星期几的汉字保存在ws中

 First_Day_Pos_In_Week_Area = InStr(week_str, ws) '每月初始的1号在日历星期区域的定位位置

 For d =𔀟 To󈅊

 da = CDate(y & "-" & m & "-" & d) '将字符串动态转换为真正的日期

 ws = Mid(Format(da, "[$-804]aaaa"),𔀡) '从转换为星期XX的字符串中提取大写星期几的汉字保存在ws中

 Other_Day_Pos_In_Week_Area = InStr(week_str, ws)

 '实际的每月的号数应该加上每月初始的1号在日历星期区域的定位位置减去1“”d + (First_Day_Pos_In_Week_Area -𔀟)，为了在第7个位置仍然将该号 _

 数放在该行，所以还得再减去1“d + (First_Day_Pos_In_Week_Area -𔀟) -𔀟”，然后再除7取整，同时乘以7后加上该号数在日历中星期区域的实际列数 _

 位置，即可得到该号数在日历区域的设计位置

 p = Int((d + (First_Day_Pos_In_Week_Area -𔀟) -𔀟) /𔀥) *𔀥 + Other_Day_Pos_In_Week_Area

 yl_md = Right(GetYLDate(da),𔀢) '调用转农历(阴历)函数，取后四个汉字月日日期字符

 yl_m = Left(yl_md,𔀠) '拆解阴历月日中的月份

 yl_d = Right(yl_md,𔀠) '拆解阴历月日中的日子

 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 =𔀟

 da = CDate(y & "-" & m & "-" & d) '将字符串动态转换为真正的日期

 ws = Mid(Format(da, "[$-804]aaaa"),𔀡) '从转换为星期XX的字符串中提取大写星期几的汉字保存在ws中

 First_Day_Pos_In_Week_Area = InStr(week_str, ws) '每月初始的1号在日历星期区域的定位位置

 If Is_LeepYear(y) Then '闰年2月份天数

 For d =𔀟 To󈅉

 da = CDate(y & "-" & m & "-" & d) '将字符串动态转换为真正的日期

 ws = Mid(Format(da, "[$-804]aaaa"),𔀡) '从转换为星期XX的字符串中提取大写星期几的汉字保存在ws中

 Other_Day_Pos_In_Week_Area = InStr(week_str, ws)

 '实际的每月的号数应该加上每月初始的1号在日历星期区域的定位位置减去1“”d + (First_Day_Pos_In_Week_Area -𔀟)，为了在第7个位置仍然将该 _

 号数放在该行，所以还得再减去1“d + (First_Day_Pos_In_Week_Area -𔀟) -𔀟”，然后再除7取整，同时乘以7后加上该号数在日历中星期区域的实 _

 际列数位置，即可得到该号数在日历区域的设计位置

 p = Int((d + (First_Day_Pos_In_Week_Area -𔀟) -𔀟) /𔀥) *𔀥 + Other_Day_Pos_In_Week_Area

 yl_md = Right(GetYLDate(da),𔀢) '调用转农历(阴历)函数，取后四个汉字月日日期字符

 yl_m = Left(yl_md,𔀠) '拆解阴历月日中的月份

 yl_d = Right(yl_md,𔀠) '拆解阴历月日中的日子

 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 =𔀟 To󈅈

 da = CDate(y & "-" & m & "-" & d) '将字符串动态转换为真正的日期

 ws = Mid(Format(da, "[$-804]aaaa"),𔀡) '从转换为星期XX的字符串中提取大写星期几的汉字保存在ws中

 Other_Day_Pos_In_Week_Area = InStr(week_str, ws)

 '实际的每月的号数应该加上每月初始的1号在日历星期区域的定位位置减去1“”d + (First_Day_Pos_In_Week_Area -𔀟)，为了在第7个位置仍然将该 _

 号数放在该行，所以还得再减去1“d + (First_Day_Pos_In_Week_Area -𔀟) -𔀟”，然后再除7取整，同时乘以7后加上该号数在日历中星期区域的实 _

 际列数位置，即可得到该号数在日历区域的设计位置

 p = Int((d + (First_Day_Pos_In_Week_Area -𔀟) -𔀟) /𔀥) *𔀥 + Other_Day_Pos_In_Week_Area

 yl_md = Right(GetYLDate(da),𔀢) '调用转农历(阴历)函数，取后四个汉字月日日期字符

 yl_m = Left(yl_md,𔀠) '拆解阴历月日中的月份

 yl_d = Right(yl_md,𔀠) '拆解阴历月日中的日子

 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� =𔀞) Or (y Mod� <>𔀞 And y Mod𔀢 =𔀞) Then

 Is_LeepYear = True

 Else

 Is_LeepYear = False

 End If

End Function

'自定义“公历转农历”日期函数

Function GetYLDate(ByVal strDate As String) As String

 On Error GoTo ExitFunction_Label

 If Not IsDate(strDate) Then Exit Function '如果参数strDate非日期的无效字符串，则退出本函数工作

 '定义setDate--设置的未来日期，tYear--未来日期的本年份，tMonth--本月份，tDay--本日子

 Dim setDate As Date, tYear As Integer, tMonth As Integer, tDay As Integer

 setDate = CDate(strDate) '为该GetYLDate()函数参数的字符串转换后的日期赋予设定的日期

 tYear = Year(setDate): tMonth = Month(setDate): tDay = Day(setDate) '年、月、日分别取值

 '如果不是有效有日期，退出

 If tYear >� Or tYear <� Then Exit Function

 '定义daList()--是元素为18位日期二进制字符串数组，conDate--农历新年日期，thisMonths--本年的二进制 _

 月份信息(可能包含闰月)

 Dim daList() As String *󈄾, conDate As Date, thisMonths As String

 '定义AddYear--是相对1900年递增的年，AddMonth--月份增量，AddDay--天数增量，getDay--农历新年和设 _

 之日期相差天数

 Dim AddYear As Integer, AddMonth As Integer, AddDay As Integer, getDay As Integer

 '定义YLyear--农历(阴历)年的字符串，YLShuXing--农历(阴历)年的属相

 Dim YLyear As String, YLShuXing As String

 '定义dd0--农历(阴历)年的阴历日子，mm0--农历(阴历)年的阴历月，ganzhi()--每个元素为2个字符的天干地 _

 支数组

 Dim dd0 As String, mm0 As String, ganzhi(0 To󈅧) As String *𔀠

 '定义RunYue--农历(阴历)年是否闰月的布尔型标志，RunYue1--农历(阴历)年闰月月份

 Dim RunYue As Boolean, RunYue1 As Integer, mDays As Integer, i As Integer

 '加载2年内的农历数据

 ReDim daList(tYear -𔀟 To tYear)

 daList(tYear -𔀟) = Hexadecimal_To_Binary(Mid(ylData, (tYear -�) *𔀦 +𔀟,𔀥))

 daList(tYear) = Hexadecimal_To_Binary(Mid(ylData, (tYear -� +𔀟) *𔀦 +𔀟,𔀥))

 AddYear = tYear

initYL:

 AddMonth = CInt(Mid(daList(AddYear),󈄻,𔀠))

 AddDay = CInt(Mid(daList(AddYear),󈄽,𔀠))

 conDate = DateSerial(AddYear, AddMonth, AddDay) '农历新年日期

 getDay = DateDiff("d", conDate, setDate) +𔀟 '相差天数

 If getDay <𔀟 Then AddYear = AddYear -𔀟: GoTo initYL

 thisMonths = Left(daList(AddYear),󈄺) '前14位为本年的二进制月份信息(可能有闰月)存于thisMonths中

 RunYue1 = Val("&H" & Right(thisMonths,𔀟)) '闰月月份

 If RunYue1 >𔀞 Then '如果有闰月，则立即修正本年的二进制月份信息thisMonths，形成真正有效的二进制序 _

 列信息

 thisMonths = Left(thisMonths, RunYue1) & Mid(thisMonths,󈄹,𔀟) & Mid(thisMonths, RunYue1 +𔀟)

 End If

 thisMonths = Left(thisMonths,󈄹) '最后一次修正本年的二进制月份信息thisMonths，直接取13个月的情况

 For i =𔀟 To󈄹 '遍历1～13个月，找到并计算含闰月的有效天数，同时退出循环

 mDays =󈅉 + CInt(Mid(thisMonths, i,𔀟))

 If getDay > mDays Then

 getDay = getDay - mDays

 Else

 If RunYue1 >𔀞 Then '如果有闰月，则进一步根据i的值情况做如下处理

 If i = RunYue1 +𔀟 Then RunYue = True '若i确系为闰月，则将闰月标志置为真

 If i > RunYue1 Then i = i -𔀟 '若i大于闰月月份，则将将i回退修正

 End If

 AddMonth = i '最终记录下i作为真正的增量月份存入AddMonth

 AddDay = getDay '同时，将得到的天数差作为增量天数

 Exit For

 End If

 Next

 dd0 = Mid(ylMd0, (AddDay -𔀟) *𔀠 +𔀟,𔀠) '用查找表的形式定位当前日期对应的农历(阴历)日子

 mm0 = Mid(ylMn0, AddMonth,𔀟) + "月" '用查找表的形式定位当前日期对应的农历(阴历)月份

 For i =𔀞 To󈅧 '0～59表示60年一个甲子，表示以60年一个轮回的形式，通过查找表精准定位每年的天干地支

 ganzhi(i) = Mid(ylTianGan0, (i Mod󈄶) +𔀟,𔀟) + Mid(ylDiZhi0, (i Mod󈄸) +𔀟,𔀟)

 Next

 YLyear = ganzhi((AddYear -𔀢) Mod󈅨) '通过查找表形式得出阴历年的天干地支表示形式

 YLShuXing = Mid(ylShu0, ((AddYear -𔀢) Mod󈄸) +𔀟,𔀟) '通过查找表形式得出阴历年的属相表示形式

 If RunYue Then mm0 = "闰" & mm0 '如果某阴历月份有闰月，特别加上“闰X月”的形式

 GetYLDate = "农历：" & YLyear & "(" & YLShuXing & ")年" & mm0 & dd0 '拼接当前日期的完整农历信息

ExitFunction_Label:

End Function

'将压缩的阴历字符还原

Private Function Hexadecimal_To_Binary(ByVal strHex As String) As String '十六进制转二进制

 Dim i As Integer, i1 As Integer, tmpV As String

 Const hStr = "0123456789ABCDEF"

 Const bStr = "0000000100100011010001010110011110001001101010111100110111101111"

 tmpV = UCase(Left(strHex,𔀡))

 '以下是十六进制转二进制的具体操作

 For i =𔀟 To Len(tmpV)

 i1 = InStr(hStr, Mid(tmpV, i,𔀟))

 Hexadecimal_To_Binary = Hexadecimal_To_Binary & Mid(bStr, (i1 -𔀟) *𔀢 +𔀟,𔀢)

 Next

 Hexadecimal_To_Binary = Hexadecimal_To_Binary & Mid(strHex,𔀢,𔀠)

 '十六进制转十进制

 Hexadecimal_To_Binary = Hexadecimal_To_Binary & "0" & CStr(Val("&H" & Right(strHex,𔀠)))

End Function

ThisWorkbook中代码如下：

Private Sub Workbook_Open() '工作簿一打开即刻初始化表单组合框数据并且在组合框中显示之前选择过的年份

 Set shp_year_select = Sheets(1).Shapes("年份选择")

 shp_year_select.ControlFormat.RemoveAllItems

 '万年历的年份范围初步设定为“1900～2100”

 For i =� To�

 shp_year_select.ControlFormat.AddItem i

 Next

 '以下是重新还原表单组合框控件之前选定过的年份显示

 yr = [a65535]

 For i =𔀟 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高级办公)、推广、点评哦！谢谢大家继续关注下期第二中方法实现带农历的万年历设计！