Excel自定义求农历函数nongli公历日期显示序号.docx
- 文档编号:28422020
- 上传时间:2023-07-13
- 格式:DOCX
- 页数:34
- 大小:23.64KB
Excel自定义求农历函数nongli公历日期显示序号.docx
《Excel自定义求农历函数nongli公历日期显示序号.docx》由会员分享,可在线阅读,更多相关《Excel自定义求农历函数nongli公历日期显示序号.docx(34页珍藏版)》请在冰豆网上搜索。
Excel自定义求农历函数nongli公历日期显示序号
OptionBase1
DimrqAsInteger'日期
DimyAsDate'农历正月月初一的阳历日期
DimytsAsVariant'农历每月的天数
Dimyy
(2)AsInteger'农历闰月数、阳历闰年数(闰年为1,不闰年为0)
Dimnl(3,385)AsString'阳历日期字符串、农历日期字符串、农历闰月字符串
FunctionNONGLI(glrqAsDate,nlrAsInteger)
DimXAsInteger,iAsInteger,kAsInteger,n1AsInteger,n2AsInteger
X=Year(glrq)
IfX<1900Orglrq>#1/28/2101#Then
NONGLI="?
"
ExitFunction
EndIf
'1、将X年的阴阳历等,通过运行程序2,装入数组
IfX<2021ThenCallArray1(X,n1,glrq)
IfX>2020ThenCallArray2(X,n1,glrq)
'2、查找阳历日期所在数组的序号rq
di2bu:
rq=0
IfX=1899Then
rq=Day(glrq)
Else
Fori=1Ton1
Ifnl(1,i)=glrqThenrq=i:
ExitFor
Nexti
EndIf
'3、填写"农历日期"(包括节日、纪念日)
Dimnongli1$,yr$,yuefen$,yf$,rizi$,rz$
Dimjr1AsString,jr2AsString,jr3AsString
nongli1=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"形式表示
DimyuefenBAsVariant,yfBAsVariant
yuefenB=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("正月","二月","三月","四月","五月","六月","七月","八月","九月","十月","冬月","腊月","闰二月","闰三月","闰四月","闰五月","闰六月","闰七月","闰八月","闰九月","闰十月","闰冬月","闰腊月")
Fori=1To23'农历的月份以汉字形式表示
Ifyuefen=yuefenB(i)Thenyf=yfB(i):
ExitFor
Nexti
DimrzBAsVariant
rzB=Array("初一","初二","初三","初四","初五","初六","初七","初八","初九","初十","十一","十二","十三","十四","十五","十六","十七","十八","十九","二十","廿一","廿二","廿三","廿四","廿五","廿六","廿七","廿八","廿九","三十")
Fori=1To30
Ifrizi=iThenrz=rzB(i):
ExitFor'农历的日子以汉字形式表示
Nexti
'农历节日--jr1
Ifnlr=3ThenCallnljr(rizi,yuefen,yuefenB,yfB,yr,yts,jr1)
'24节气--ji2
DimxiaohanAsDate
xiaohan=Int(365.242646137797*Year(glrq)-693953.924646684)
Ifglrq=xiaohanThenjr2="小寒"
DimdahanAsDate
dahan=Int(365.242629416257*Year(glrq)-693939.16865395)
IfYear(glrq)=2082Thendahan=dahan+1
Ifglrq=dahanThenjr2="大寒"
DimlichunAsDate
lichun=Int(365.24259976737*Year(glrq)-693924.346732722)
Ifglrq=lichunThenjr2="立春"
DimyushuiAsDate
yushui=Int(365.242502247697*Year(glrq)-693909.331831532)
IfYear(glrq)=2059OrYear(glrq)=2092Thenyushui=yushui+1
Ifglrq=yushuiThenjr2="雨水"
DimjingzheAsDate
jingzhe=Int(365.242419549484*Year(glrq)-693894.233446856)
IfYear(glrq)=2047Thenjingzhe=jingzhe+1
Ifglrq=jingzheThenjr2="惊蛰"
DimchunfenAsDate
chunfen=Int(365.242305278251*Year(glrq)-693878.966116765)
IfYear(glrq)=2051Thenchunfen=chunfen-1
Ifglrq=chunfenThenjr2="春分"
DimqingmingAsDate
qingming=Int(365.242254377632*Year(glrq)-693863.694715595)
Ifglrq=qingmingThenjr2="清明"
DimguyuAsDate
guyu=Int(365.242150678344*Year(glrq)-693848.193860396)
IfYear(glrq)=2045Thenguyu=guyu-1
Ifglrq=guyuThenjr2="谷雨"
DimlixiaAsDate
lixia=Int(365.242041986455*Year(glrq)-693832.541539829)
IfYear(glrq)=1973OrYear(glrq)=2035Thenlixia=lixia-1
Ifglrq=lixiaThenjr2="立夏"
DimxiaomanAsDate
xiaoman=Int(365.241895042148*Year(glrq)-693816.712806842)
IfYear(glrq)=2070Thenxiaoman=xiaoman-1
Ifglrq=xiaomanThenjr2="小满"
DimmangzhongAsDate
mangzhong=Int(365.241908822174*Year(glrq)-693801.095841903)
IfYear(glrq)=2026OrYear(glrq)=2055OrYear(glrq)=2088Thenmangzhong=mangzhong-1
Ifglrq=mangzhongThenjr2="芒种"
DimxiazhiAsDate
xiazhi=Int(365.242316100823*Year(glrq)-693786.181888162)
IfYear(glrq)=2019OrYear(glrq)=2023OrYear(glrq)=2048OrYear(glrq)=2052OrYear(glrq)=2056OrYear(glrq)=2081OrYear(glrq)=2085OrYear(glrq)=2089Thenxiazhi=xiazhi-1
Ifglrq=xiazhiThenjr2="夏至"
DimxiaoshuAsDate
xiaoshu=Int(365.241837274251*Year(glrq)-693769.530669936)
IfYear(glrq)=2078Thenxiaoshu=xiaoshu-1
Ifglrq=xiaoshuThenjr2="小暑"
DimdashuAsDate
dashu=Int(365.241703595146*Year(glrq)-693753.549346385)
Ifglrq=dashuThenjr2="大暑"
DimliqiuAsDate
liqiu=Int(365.241890113665*Year(glrq)-693738.222492901)
IfYear(glrq)=2035OrYear(glrq)=2068OrYear(glrq)=2097Thenliqiu=liqiu-1
Ifglrq=liqiuThenjr2="立秋"
DimchushuAsDate
chushu=Int(365.242316100823*Year(glrq)-693723.45493336)
IfYear(glrq)=2020OrYear(glrq)=2049OrYear(glrq)=2053Thenchushu=chushu-1
Ifglrq=chushuThenjr2="处暑"
DimbailuAsDate
bailu=Int(365.242316100823*Year(glrq)-693707.939588367)
Ifglrq=bailuThenjr2="白露"
DimqiufenAsDate
qiufen=Int(365.242085926645*Year(glrq)-693692.119710911)
Ifglrq=qiufenThenjr2="秋分"
DimhanluAsDate
hanlu=Int(365.242316100823*Year(glrq)-693677.304821888)
IfYear(glrq)=2073Thenhanlu=hanlu-1
Ifglrq=hanluThenjr2="寒露"
DimshuangjiangAsDate
shuangjiang=Int(365.242316100823*Year(glrq)-693662.177281271)
Ifglrq=shuangjiangThenjr2="霜降"
DimlidongAsDate
lidong=Int(365.242316100823*Year(glrq)-693647.185448183)
Ifglrq=lidongThenjr2="立冬"
DimxiaoxueAsDate
xiaoxue=Int(365.242316100823*Year(glrq)-693632.293388525)
IfYear(glrq)=1912Thenxiaoxue=xiaoxue-1
Ifglrq=xiaoxueThenjr2="小雪"
DimdaxueAsDate
daxue=Int(365.242199074074*Year(glrq)-693617.264427083)
IfYear(glrq)=2020OrYear(glrq)=2053OrYear(glrq)=2082Thendaxue=daxue+1
Ifglrq=daxueThenjr2="大雪"
DimdongzhiAsDate
dongzhi=Int(365.242615913523*Year(glrq)-693603.343641496)
IfYear(glrq)=2054OrYear(glrq)=2087Thendongzhi=dongzhi+1
Ifglrq=dongzhiThenjr2="冬至一九第一天"
Fori=10To73Step9
IfMonth(glrq)<>12Thendongzhi=Int(365.242615913523*(Year(glrq)-1)-693603.343641496):
IfYear(glrq)-1=2054OrYear(glrq)-1=2087Thendongzhi=dongzhi+1
Ifi=glrq-dongzhi+1Then
Ifi=10Thenjr2=jr2&"二九第一天":
ExitFor
Ifi=19Thenjr2=jr2&"三九第一天":
ExitFor
Ifi=28Thenjr2=jr2&"四九第一天":
ExitFor
Ifi=37Thenjr2=jr2&"五九第一天":
ExitFor
Ifi=46Thenjr2=jr2&"六九第一天":
ExitFor
Ifi=55Thenjr2=jr2&"七九第一天":
ExitFor
Ifi=64Thenjr2=jr2&"八九第一天":
ExitFor
Ifi=73Thenjr2=jr2&"九九第一天":
ExitFor
EndIf
Nexti
'公历节日--jr3
Ifnlr=3ThenCallgljr(glrq,jr3)
'4、日期的天干地支
di4bu:
Ifnlr<>5ThenGoTodi5bu
DimganzhiBAsVariant
ganzhiB=Array("甲子","乙丑","丙寅","丁卯","戊辰","己巳","庚午","辛未","壬申","癸酉","甲戌","乙亥","丙子","丁丑","戊寅","己卯","庚辰","辛巳","壬午","癸未","甲申","乙酉","丙戌","丁亥","戊子","己丑","庚寅","辛卯","壬辰","癸巳","甲午","乙未","丙申","丁酉","戊戌","己亥","庚子","辛丑","壬寅","癸卯","甲辰","乙巳","丙午","丁未","戊申","己酉","庚戌","辛亥","壬子","癸丑","甲寅","乙卯","丙辰","丁巳","戊午","己未","庚申","辛酉","壬戌","癸亥")
'
(1)把农历年份的天干地支赋值于ngz,农历1984年是:
甲子年
Dimns%,ngz$
IfX=Year(glrq)Andglrq X-1 ns=X-1-1983 ElseIfX=Year(glrq)-1Andglrq>=lichunThenns=X+1-1983'春节前立春时,大于等于立春的日子为下一年: X+1 Else ns=X-1983'其他日子为当年: X EndIf ns=nsMod60 Ifns<=0Thenns=ns+60'年干支数 ngz=ganzhiB(ns)'年干支 ' (2)把农历月份的天干地支赋值于ygz Dimyfs%,ntgs%,ytgs%,ydzs%,ygzs%,ygz$ Ifglrq yfs=11 ElseIfglrq ElseIfglrq ElseIfglrq ElseIfglrq ElseIfglrq ElseIfglrq ElseIfglrq ElseIfglrq ElseIfglrq ElseIfglrq ElseIfglrq Else yfs=11 EndIf ntgs=nsMod5: Ifntgs=0Thenntgs=5'年天干数(1—5) ytgs=(ntgs*2+yfs)Mod10: Ifytgs=0Thenytgs=10'月天干数(口诀: 年上起月不麻烦,月干周期为五年。 从一到五数年干,数到当年就算完;此数两倍加月份,个位之数月干选。 ) ydzs=yfs+2: Ifydzs>12Thenydzs=ydzs-12'月地支数(口诀: 月份之数加上二,超出十二减十二。 ) ygzs=((ytgs-ydzs+12)Mod12)*5+ytgs'月干支数(口诀: 天干减地支,不够借十二;其差乘以五,再加天干补。 ) ygz=ganzhiB(ygzs)'月干支 '(3)把农历日的天干地支赋值于rgz,1984-1-31是: 甲子日 Dimrs%,rgz$ rs=glrq-#1/30/1984#: rs=rsMod60: Ifrs<=0Thenrs=rs+60'日干支数 rgz=ganzhiB(rs)'日干支 '5、定义农历函数--NONGLI di5bu: SelectCasenlr'判断nlr的值。 Case1 NONGLI=nongli1'nlr=1时,函数NONGLI为"yyyy-mm-dd"的形式 Case2 NONGLI=yr'nlr=1时,函数NONGLI为"mm-dd"的形式 Case3 Ifjr1&jr2&jr3<>""ThenNONGLI=jr1&jr2&jr3ElseNONGLI=rz'nlr=3时,函数NONGLI是节日时为"××"节日形式,否则为"初十"的形式 Case4 NONGLI=rz'nlr=4时,函数NONGLI为"初十"的形式 Case5 NONGLI=ngz&""&ygz&""&rgz'nlr=时,函数NONGLI为"甲子丙寅丙寅"的形式 CaseElse NONGLI=yf&rz'nlr≠1~5的整数时,函数NONGLI的形式,同nlr=1时 EndSelect ExitFunction 'zichengxu2: EndFunction SubArray1(XAsInteger,n1AsInteger,glrqAsDate) ''********************装数组程序: (1900--2020),返回农历年份--a(即原X)和此年总天数--b*****************'' zichengxu2: 1899: IfX=1899Theny=#1/1/1899#: yts=Array(30,0,0,0,0,0,0,0,0,0,0,0,0,0): GoTozuihou 1900: IfX=1900Theny=#1/31/1900#: Ifglrq GoTozichengxu2Elseyts=Array(29,30,29,29,30,29,30,30,29,30,30,29,30,8): GoTozuihou IfX>2020ThenExitSubElseIfX>=2000ThenGoTo2000ElseIfX>=1980ThenGoTo1980ElseIfX>=1960ThenGoTo1960ElseIfX>=1940ThenGoTo1940 1901: IfX=1901Theny=#2/19/1901#: Ifglrq GoTozichengxu2Elseyts=Array(29,30,29,29,30,29,30,29,30,30,30,29,0,0): GoTozuihou 1902: IfX=1902Theny=#2/8/1902#: Ifglrq GoTozichengxu2Elseyts=Array(30,29,30,29,29,30,29,30,29,30,30,30,0,0): GoTozuihou 1903: IfX=1903Theny=#1/29/1903#: Ifglrq GoTozichengxu
- 配套讲稿:
如PPT文件的首页显示word图标,表示该PPT已包含配套word讲稿。双击word图标可打开word文档。
- 特殊限制:
部分文档作品中含有的国旗、国徽等图片,仅作为作品整体效果示例展示,禁止商用。设计者仅对作品中独创性部分享有著作权。
- 关 键 词:
- Excel 自定义 农历 函数 nongli 公历 日期 显示 序号
![提示](https://static.bdocx.com/images/bang_tan.gif)