Excel自定义求农历函数――nongli(公历日期,显示序号)

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 = Year(glrq)If X < 1900 Or glrq > #1/28/2101# ThenNONGLI = "？"Exit FunctionEnd If'1、将X年的阴阳历等，通过运行程序2，装入数组If X < 2021 Then Call Array1(X, n1, glrq)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 If'3、填写"农历日期"(包括节日、纪念日)Dim nongli1$, yr$, 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(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("正月", "二月", "三月", "四月", "五月", "六月", "七月", "八月", "九月", "十月", "冬月", "腊月", "闰二月", "闰三月", "闰四月", "闰五月", "闰六月", "闰七月", "闰八月", "闰九月", "闰十月", "闰冬月", "闰腊月")For i = 1 To 23'农历的月份以汉字形式表示If yuefen = yuefenB(i) Then yf = yfB(i): Exit ForNext iDim rzB As VariantrzB = Array("初一", "初二", "初三", "初四", "初五", "初六", "初七", "初八", "初九", "初十", "十一", "十二", "十三", "十四", "十五", "十六", "十七", "十八", "十九", "二十", "廿一", "廿二","廿三", "廿四", "廿五", "廿六", "廿七", "廿八", "廿九", "三十")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 * 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 glrq = 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) = 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) - 693863.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 Year(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) - 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) = 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 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 Then 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 = 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 shuangjiang 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.293388525)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 Datedongzhi = 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 9IfMonth(glrq)<>12Thendongzhi=Int(365.242615913523*(Year(glrq)-1)-693603.343641496): If Year(glrq) - 1 = 2054 Or Year(glrq) - 1 = 2087 Then dongzhi = dongzhi +1If i = glrq - dongzhi + 1 ThenIf i = 10 Then jr2 = jr2 & "二九第一天": Exit ForIf i = 19 Then jr2 = jr2 & "三九第一天": Exit ForIf i = 28 Then jr2 = jr2 & "四九第一天": Exit ForIf i = 37 Then jr2 = jr2 & "五九第一天": Exit ForIf i = 46 Then jr2 = jr2 & "六九第一天": Exit ForIf i = 55 Then jr2 = jr2 & "七九第一天": Exit ForIf i = 64 Then jr2 = jr2 & "八九第一天": Exit ForIf i = 73 Then jr2 = jr2 & "九九第一天": Exit ForEnd IfNext i'公历节日--jr3If nlr = 3 Then Call gljr(glrq, jr3)'4、日期的天干地支di4bu: If nlr <> 5 Then GoTo di5buDim ganzhiB As VariantganzhiB = Array("甲子", "乙丑", "丙寅", "丁卯", "戊辰", "己巳", "庚午", "辛未", "壬申", "癸酉", "甲戌", "乙亥", "丙子", "丁丑", "戊寅", "己卯", "庚辰", "辛巳", "壬午", "癸未", "甲申", "乙酉", "丙戌", "丁亥", "戊子", "己丑", "庚寅", "辛卯", "壬辰", "癸巳", "甲午", "乙未", "丙申", "丁酉", "戊戌", "己亥", "庚子", "辛丑", "壬寅", "癸卯", "甲辰", "乙巳", "丙午", "丁未", "戊申","己酉", "庚戌", "辛亥", "壬子", "癸丑", "甲寅", "乙卯", "丙辰", "丁巳", "戊午", "己未", "庚申","辛酉", "壬戌", "癸亥")'(1)把农历年份的天干地支赋值于ngz，农历1984年是：甲子年Dim ns%, ngz$If X = Year(glrq) And glrq < lichun Then'春节后立春时，小于立春的日子为上一年：X-1ns = X - 1 - 1983ElseIf X = Year(glrq) - 1 And glrq >= lichun Then ns = X + 1 - 1983 '春节前立春时，大于等于立春的日子为下一年：X+1Elsens = X - 1983'其他日子为当年：XEnd Ifns = ns Mod 60If ns <= 0 Then ns = ns + 60 '年干支数ngz = ganzhiB(ns)'年干支'(2)把农历月份的天干地支赋值于ygzDim yfs%, ntgs%, ytgs%, ydzs%, ygzs%, ygz$If glrq < xiaohan Then'农历月份数'小寒yfs = 11ElseIf glrq < lichun Then yfs = 12'立春ElseIf glrq < jingzhe Then yfs = 1'惊蛰ElseIf glrq < qingming Then yfs = 2'清明ElseIf glrq < lixia Then yfs = 3'立夏ElseIf glrq < mangzhong Then yfs = 4'芒种ElseIf glrq < xiaoshu Then yfs = 5'小暑ElseIf glrq < liqiu Then yfs = 6'立秋ElseIf glrq < bailu Then yfs = 7'白露ElseIf glrq < hanlu Then yfs = 8'寒露ElseIf glrq < lidong Then yfs = 9'立冬ElseIf glrq < daxue Then yfs = 10'大雪Elseyfs = 11End Ifntgs = ns Mod 5: If ntgs = 0 Then ntgs = 5'年天干数（1—5）ytgs = (ntgs * 2 + yfs) Mod 10: If ytgs = 0 Then ytgs = 10'月天干数（口诀：年上起月不麻烦，月干周期为五年。