1、Option Base 1Dim rq As Integer 日期Dim y As Date 农历正月月初一的阳历日期Dim yts As Variant 农历每月的天数Dim yy(2) As Integer 农历闰月数、阳历闰年数（闰年为 1，不闰年为 0）Dim nl(3, 385) As String 阳历日期字符串、农历日期字符串、农历闰月字符串Function NONGLI(glrq As Date, nlr As Integer)Dim X As Integer, i As Integer, k As Integer, n1 As Integer, n2 As IntegerX
2、= Year(glrq)If X #1/28/2101# ThenNONGLI = “？ “Exit FunctionEnd If1、将 X 年的阴阳历等，通过运行程序 2，装入数组If X 2020 Then Call Array2(X, n1, glrq)2、查找阳历日期所在数组的序号 rqdi2bu: rq = 0If X = 1899 Thenrq = Day(glrq)ElseFor i = 1 To n1If nl(1, i) = glrq Then rq = i: Exit ForNext iEnd If3、填写“ 农历日期“(包括节日、纪念日)Dim nongli1$, yr$
3、, yuefen$, yf$, rizi$, rz$Dim jr1 As String, jr2 As String, jr3 As Stringnongli1 = nl(2, rq) 农历日期以“2014-2-1“或“2014-闰 9-1“的形式表示yr = Strings.Right(nongli1, Strings.Len(nongli1) - 5) 农历日期以“2-1“或“ 闰 9-1“形式表示yuefen = Strings.Left(yr, Strings.InStrRev(yr, “-“) - 1) 农历的月份以 “2“或“闰 9“形式表示rizi = Strings.Right
4、(yr, Strings.Len(yr) - Strings.InStrRev(yr, “-“) 农历的日子以“2“形式表示Dim yuefenB As Variant, yfB As VariantyuefenB = Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, “闰 2“, “闰 3“, “闰 4“, “闰 5“, “闰 6“, “闰 7“, “闰 8“, “闰 9“, “闰 10“, “闰 11“, “闰 12“)yfB = Array(“正月 “, “二月“, “三月“, “四月“, “五月“, “六月“, “七月“, “八月“, “九月“,
5、 “十月“, “冬月“, “腊月“, “闰二月“, “闰三月“, “闰四月“, “闰五月“, “闰六月“, “闰七月“, “闰八月“, “闰九月“, “ 闰十月“, “闰冬月“, “闰腊月“)For i = 1 To 23 农历的月份以汉字形式表示If yuefen = yuefenB(i) Then yf = yfB(i): Exit ForNext iDim rzB As VariantrzB = Array(“初一“, “初二“, “初三“, “初四“, “初五“, “初六“, “初七“, “初八“, “初九“, “初十“, “十一“, “十二“, “十三“, “十四“, “十五“, “
6、十六“, “十七“, “十八 “, “十九“, “二十“, “廿一“, “廿二“, “廿三“, “ 廿四“, “廿五“, “ 廿六“, “ 廿七“, “廿八“, “廿九“, “三十 “)For i = 1 To 30If rizi = i Then rz = rzB(i): Exit For 农历的日子以汉字形式表示Next i农历节日-jr1If nlr = 3 Then Call nljr(rizi, yuefen, yuefenB, yfB, yr, yts, jr1)24 节气-ji2Dim xiaohan As Datexiaohan = Int(365.242646137797 *
7、 Year(glrq) - 693953.924646684)If glrq = xiaohan Then jr2 = “小寒“Dim dahan As Datedahan = Int(365.242629416257 * Year(glrq) - 693939.16865395)If Year(glrq) = 2082 Then dahan = dahan + 1If glrq = dahan Then jr2 = “大寒 “Dim lichun As Datelichun = Int(365.24259976737 * Year(glrq) - 693924.346732722)If gl
8、rq = lichun Then jr2 = “立春 “Dim yushui As Dateyushui = Int(365.242502247697 * Year(glrq) - 693909.331831532)If Year(glrq) = 2059 Or Year(glrq) = 2092 Then yushui = yushui + 1If glrq = yushui Then jr2 = “雨水“Dim jingzhe As Datejingzhe = Int(365.242419549484 * Year(glrq) - 693894.233446856)If Year(glrq
9、) = 2047 Then jingzhe = jingzhe + 1If glrq = jingzhe Then jr2 = “惊蛰“Dim chunfen As Datechunfen = Int(365.242305278251 * Year(glrq) - 693878.966116765)If Year(glrq) = 2051 Then chunfen = chunfen - 1If glrq = chunfen Then jr2 = “春分 “Dim qingming As Dateqingming = Int(365.242254377632 * Year(glrq) - 69
10、3863.694715595)If glrq = qingming Then jr2 = “清明“Dim guyu As Dateguyu = Int(365.242150678344 * Year(glrq) - 693848.193860396)If Year(glrq) = 2045 Then guyu = guyu - 1If glrq = guyu Then jr2 = “谷雨“Dim lixia As Datelixia = Int(365.242041986455 * Year(glrq) - 693832.541539829)If Year(glrq) = 1973 Or Ye
11、ar(glrq) = 2035 Then lixia = lixia - 1If glrq = lixia Then jr2 = “立夏“Dim xiaoman As Datexiaoman = Int(365.241895042148 * Year(glrq) - 693816.712806842)If Year(glrq) = 2070 Then xiaoman = xiaoman - 1If glrq = xiaoman Then jr2 = “小满“Dim mangzhong As Datemangzhong = Int(365.241908822174 * Year(glrq) -
12、693801.095841903)If Year(glrq) = 2026 Or Year(glrq) = 2055 Or Year(glrq) = 2088 Then mangzhong = mangzhong - 1If glrq = mangzhong Then jr2 = “芒种“Dim xiazhi As Datexiazhi = Int(365.242316100823 * Year(glrq) - 693786.181888162)If Year(glrq) = 2019 Or Year(glrq) = 2023 Or Year(glrq) = 2048 Or Year(glrq
13、) = 2052 Or Year(glrq) = 2056 Or Year(glrq) = 2081 Or Year(glrq) = 2085 Or Year(glrq) = 2089 Then xiazhi = xiazhi - 1If glrq = xiazhi Then jr2 = “夏至“Dim xiaoshu As Datexiaoshu = Int(365.241837274251 * Year(glrq) - 693769.530669936)If Year(glrq) = 2078 Then xiaoshu = xiaoshu - 1If glrq = xiaoshu Then
14、 jr2 = “小暑“Dim dashu As Datedashu = Int(365.241703595146 * Year(glrq) - 693753.549346385)If glrq = dashu Then jr2 = “大暑“Dim liqiu As Dateliqiu = Int(365.241890113665 * Year(glrq) - 693738.222492901)If Year(glrq) = 2035 Or Year(glrq) = 2068 Or Year(glrq) = 2097 Then liqiu = liqiu - 1If glrq = liqiu T
15、hen jr2 = “立秋 “Dim chushu As Datechushu = Int(365.242316100823 * Year(glrq) - 693723.45493336)If Year(glrq) = 2020 Or Year(glrq) = 2049 Or Year(glrq) = 2053 Then chushu = chushu - 1If glrq = chushu Then jr2 = “处暑“Dim bailu As Datebailu = Int(365.242316100823 * Year(glrq) - 693707.939588367)If glrq =
16、 bailu Then jr2 = “白露 “Dim qiufen As Dateqiufen = Int(365.242085926645 * Year(glrq) - 693692.119710911)If glrq = qiufen Then jr2 = “秋分“Dim hanlu As Datehanlu = Int(365.242316100823 * Year(glrq) - 693677.304821888)If Year(glrq) = 2073 Then hanlu = hanlu - 1If glrq = hanlu Then jr2 = “寒露“Dim shuangjia
17、ng As Dateshuangjiang = Int(365.242316100823 * Year(glrq) - 693662.177281271)If glrq = shuangjiang Then jr2 = “霜降“Dim lidong As Datelidong = Int(365.242316100823 * Year(glrq) - 693647.185448183)If glrq = lidong Then jr2 = “立冬 “Dim xiaoxue As Datexiaoxue = Int(365.242316100823 * Year(glrq) - 693632.2
18、93388525)If Year(glrq) = 1912 Then xiaoxue = xiaoxue - 1If glrq = xiaoxue Then jr2 = “小雪“Dim daxue As Datedaxue = Int(365.242199074074 * Year(glrq) - 693617.264427083)If Year(glrq) = 2020 Or Year(glrq) = 2053 Or Year(glrq) = 2082 Then daxue = daxue + 1If glrq = daxue Then jr2 = “大雪 “Dim dongzhi As D
19、atedongzhi = Int(365.242615913523 * Year(glrq) - 693603.343641496)If Year(glrq) = 2054 Or Year(glrq) = 2087 Then dongzhi = dongzhi + 1If glrq = dongzhi Then jr2 = “冬至一九第一天“For i = 10 To 73 Step 9If Month(glrq) 5 Then GoTo di5buDim ganzhiB As VariantganzhiB = Array(“甲子“, “乙丑“, “丙寅“, “丁卯“, “戊辰“, “己巳“,
20、 “庚午“, “辛未“, “壬申“, “癸酉“, “甲戌“, “乙亥“, “丙子“, “丁丑“, “戊寅“, “己卯“, “庚辰“, “辛巳“, “壬午“, “癸未“, “甲申“, “乙酉“, “丙戌“, “丁亥“, “戊子“, “己丑“, “庚寅“, “辛卯“, “壬辰 “, “癸巳“, “甲午“, “乙未“, “丙申“, “丁酉“, “戊戌“, “己亥“, “庚子“, “辛丑“, “壬寅“, “癸卯“, “甲辰 “, “乙巳“, “丙午“, “丁未“, “戊申“, “己酉“, “庚戌“, “辛亥“, “壬子“, “癸丑“, “甲寅“, “乙卯“, “丙辰“, “丁巳“, “戊午“, “己未
21、“, “庚申“, “辛酉“, “ 壬戌“, “癸亥“)(1)把农历年份的天干地支赋值于 ngz，农历 1984 年是： 甲子年Dim ns%, ngz$If X = Year(glrq) And glrq = lichun Then ns = X + 1 - 1983 春节前立春时，大于等于立春的日子为下一年：X+1Elsens = X - 1983 其他日子为当年：XEnd Ifns = ns Mod 60If ns 12 Then ydzs = ydzs - 12 月地支数( 口诀：月份之数加上二，超出十二减十二。 ）ygzs = (ytgs - ydzs + 12) Mod 12) *
22、5 + ytgs 月干支数（口诀：天干减地支，不够借十二；其差乘以五，再加天干补。 ）ygz = ganzhiB(ygzs) 月干支(3)把农历日的天干地支赋值于 rgz ，1984-1-31 是： 甲子日Dim rs%, rgz$rs = glrq - #1/30/1984#: rs = rs Mod 60: If rs “ Then NONGLI = jr1 & jr2 & jr3 Else NONGLI = rz nlr=3 时，函数NONGLI 是节日时为“节日形式，否则为“初十“的形式Case 4NONGLI = rz nlr=4 时，函数 NONGLI 为“ 初十“的形式Case
23、5NONGLI = ngz & “ “ & ygz & “ “ & rgz nlr=时，函数 NONGLI 为“ 甲子 丙寅 丙寅“的形式Case ElseNONGLI = yf & rz nlr1 5 的整数时，函数 NONGLI 的形式，同 nlr=1 时End SelectExit Functionzichengxu2:End FunctionSub Array1(X As Integer, n1 As Integer, glrq As Date)* 装数组程序：（1900-2020） ，返回农历年份-a（即原 X）和此年总天数-b *zichengxu2:1899: If X = 18
24、99 Then y = #1/1/1899#: yts = Array(30, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0): GoTo zuihou1900: If X = 1900 Then y = #1/31/1900#: If glrq 2020 Then Exit Sub Else If X = 2000 Then GoTo 2000 Else If X = 1980 Then GoTo 1980 Else If X = 1960 Then GoTo 1960 Else If X = 1940 Then GoTo 19401901: If X = 19
25、01 Then y = #2/19/1901#: If glrq 0 ThenIf k - yts(14) 1 Then nlm = CStr(k - 1)Elsenlm = CStr(k)End If100: For i = n2 + 1 To n2 + yts(k)nl(2, i) = CStr(X) & “-“ & nlm & “-“ & CStr(i - n2) 农历日期以“2014-2-1“或“1900-闰 8-1“的形式表示Next in2 = n2 + yts(k)Next kEnd SubSub Array2(X As Integer, n1 As Integer, glrq
26、As Date)* 装数组程序 2：（2021-2100） ，返回农历年份-a （即原 X）和此年总天数-b *zichengxu2:If X 2101 Then Exit Sub Else If X = 2080 Then GoTo 2080 Else If X = 2060 Then GoTo 2060 Else If X = 2040 Then GoTo 20402020: If X = 2020 Then y = #1/25/2020#: If glrq 0 ThenIf k - yts(14) 1 Then nlm = CStr(k - 1)Elsenlm = CStr(k)End
27、IfFor i = n2 + 1 To n1If i = 2000 Then jr3 = “母语日“: Exit SubIf glrq2 = “3-5“ And Year(glrq) = 1963 Then jr3 = “学雷锋“: Exit SubIf glrq2 = “3-8“ And Year(glrq) = 1910 Then jr3 = “妇女节“: Exit SubIf glrq2 = “3-12“ And Year(glrq) = 1979 Then jr3 = “植树节“: Exit SubIf glrq2 = “3-15“ And Year(glrq) = 1987 Then
28、 jr3 = “消权日“: Exit SubIf glrq2 = “3-23“ And Year(glrq) = 1950 Then jr3 = “气象日“: Exit SubIf glrq2 = “4-1“ Then jr3 = “愚人节“: Exit SubIf glrq2 = “4-7“ And Year(glrq) = 1950 Then jr3 = “卫生日“: Exit SubIf glrq2 = “4-22“ And Year(glrq) = 1970 Then jr3 = “地球日“: Exit SubIf glrq2 = “5-1“ Then jr3 = “劳动节“: Exi
29、t SubIf glrq2 = “5-4“ And Year(glrq) = 1919 Then jr3 = “青年节“: Exit SubIf glrq2 = “5-12“ And Year(glrq) = 1986 Then jr3 = “护士节“If glrq2 = “5-16“ Then jr3 = “助残日“: Exit SubIf glrq2 = “5-31“ And Year(glrq) = 1988 Then jr3 = “无烟日“: Exit SubIf Month(glrq) = 5 And Weekday(glrq) = 1 And Day(glrq) 7 And Day
30、(glrq) = 1914 Then jr3 = jr3 & “母亲节“: Exit SubIf glrq2 = “6-1“ And Year(glrq) = 1949 Then jr3 = “儿童节“: Exit SubIf glrq2 = “6-5“ And Year(glrq) = 1974 Then jr3 = “环境日“: Exit SubIf glrq2 = “6-6“ And Year(glrq) = 1996 Then jr3 = “爱眼日“: Exit SubIf glrq2 = “6-26“ And Year(glrq) = 1987 Then jr3 = “禁毒日“: E
31、xit SubIf Month(glrq) = 6 And Weekday(glrq) = 1 And Day(glrq) 14 And Day(glrq) = 1910 Then jr3 = “父亲节“: Exit SubIf glrq2 = “7-1“ And Year(glrq) = 1921 Then jr3 = “建党节“: Exit SubIf glrq2 = “7-11“ Then jr3 = “人口日“: Exit SubIf glrq2 = “8-1“ And Year(glrq) = 1927 Then jr3 = “建军节“: Exit SubIf glrq2 = “8-
32、15“ And Year(glrq) = 1945 Then jr3 = “抗日战争胜利“: Exit SubIf glrq2 = “9-8“ And Year(glrq) = 1966 Then jr3 = “扫盲日“: Exit SubIf glrq2 = “9-10“ And Year(glrq) = 1985 Then jr3 = “教师节“: Exit SubIf glrq2 = “9-20“ And Year(glrq) = 1988 Then jr3 = “爱牙日“: Exit SubIf glrq2 = “9-27“ And Year(glrq) = 1979 Then jr3
33、 = “旅游日“: Exit SubIf glrq2 = “9-28“ Then jr3 = “孔子诞辰“: Exit SubIf glrq2 = “10-1“ And Year(glrq) = 1949 Then jr3 = “国庆节“: Exit SubIf glrq2 = “10-9“ And Year(glrq) = 1969 Then jr3 = “邮政日“: Exit SubIf glrq2 = “11-1“ Then jr3 = “万圣节“: Exit SubIf glrq2 = “11-12“ Then jr3 = “孙中山诞辰“: Exit SubIf Month(glrq)
34、 = 11 And Weekday(glrq) = 5 And Month(glrq - 21) = 11 Then jr3 = “感恩节“: Exit SubIf glrq2 = “12-1“ And Year(glrq) = 1988 Then jr3 = “艾滋病日“: Exit SubIf glrq2 = “12-5“ And Year(glrq) = 1985 Then jr3 = “志愿者日“: Exit SubIf glrq2 = “12-20“ And Year(glrq) = 1999 Then jr3 = “澳门回归日“: Exit SubIf glrq2 = “12-24“ Then jr3 = “平安夜“: Exit SubIf glrq2 = “12-25“ Then jr3 = “圣诞节“If glrq2 = “12-26“ Then jr3 = “毛泽东诞辰“End Sub
