功能简单的公历农历转换VB算法

PrivateConstylMd0="初一初二初三初四初五初六初七初八初九初十十一十二十三十四十五"_&"十六十七十八十九二十廿一廿二廿三廿四廿五廿六廿七廿八廿九三十"

PrivateConstylMn0="正二三四五六七八九十冬腊"PrivateConstylTianGan0="甲乙丙丁戊已庚辛壬癸"PrivateConstylDiZhi0="子丑寅卯辰巳午未申酉戌亥"PrivateConstylShu0="鼠牛虎兔龙蛇马羊猴鸡狗猪"

'公历日期转农历FunctionGetYLDate(ByValstrDateAsString)AsString

OnErrorGoToaErr

IfNotIsDate(strDate)ThenExitFunctionDimsetDateAsDate,tYearAsInteger,tMonthAsInteger,tDayAsIntegersetDate=CDate(strDate)tYear=Year(setDate):tMonth=Month(setDate):tDay=Day(setDate)'如果不是有效有日期,退出IftYear>2100OrtYear<1900ThenExitFunctionDimdaList()AsString*18,conDateAsDate,thisMonthsAsStringDimAddYearAsInteger,AddMonthAsInteger,AddDayAsInteger,getDayAsIntegerDimYLyearAsString,YLShuXingAsStringDimdd0AsString,mm0AsString,ganzhi(0To59)AsString*2DimRunYueAsBoolean,RunYue1AsInteger,mDaysAsInteger,iAsInteger'加载2年内的农历数据ReDimdaList(tYear-1TotYear)daList(tYear-1)=H2B(Mid(ylData,(tYear-1900)*8+1,7))daList(tYear)=H2B(Mid(ylData,(tYear-1900+1)*8+1,7))AddYear=tYear

initYL:

AddMonth=CInt(Mid(daList(AddYear),15,2))AddDay=CInt(Mid(daList(AddYear),17,2))conDate=DateSerial(AddYear,AddMonth,AddDay)'农历新年日期getDay=DateDiff("d",conDate,setDate)+1'相差天数IfgetDay<1ThenAddYear=AddYear-1:GoToinitYLthisMonths=Left(daList(AddYear),14)RunYue1=Val("&H"&Right(thisMonths,1))'闰月月份IfRunYue1>0Then'有闰月thisMonths=Left(thisMonths,RunYue1)&Mid(thisMonths,13,1)&Mid(thisMonths,RunYue1+1)EndIfthisMonths=Left(thisMonths,13)Fori=1To13'计算天数mDays=29+CInt(Mid(thisMonths,i,1))IfgetDay>mDaysThengetDay=getDay-mDaysElseIfRunYue1>0ThenIfi=RunYue1+1ThenRunYue=TrueIfi>RunYue1Theni=i-1EndIfAddMonth=iAddDay=getDayExitForEndIfNextdd0=Mid(ylMd0,(AddDay-1)*2+1,2)mm0=Mid(ylMn0,AddMonth,1)+"月"Fori=0To59ganzhi(i)=Mid(ylTianGan0,(iMod10)+1,1)+Mid(ylDiZhi0,(iMod12)+1,1)Nexti

YLyear=ganzhi((AddYear-4)Mod60)YLShuXing=Mid(ylShu0,((AddYear-4)Mod12)+1,1)IfRunYueThenmm0="闰"&mm0GetYLDate="农历"&YLyear&"("&YLShuXing&")年"&mm0&dd0

aErr:EndFunction

'农历转公历日期'secondMonth为真,则天示当tMonth是闰月时,取第二个月FunctionGetDate(ByValtYearAsInteger,tMonthAsInteger,tDayAsInteger,OptionalsecondMonthAsBoolean=False)AsString

IftYear>2100OrtYear<1899OrtMonth>12OrtMonth<1OrtDay>30OrtDay<1ThenExitFunctionDimthisMonthsAsString,ylNewYearAsDate,toMonthAsIntegerDimmDaysAsInteger,RunYue1AsInteger,iAsIntegerthisMonths=H2B(Mid(ylData,(tYear-1899)*8+1,7))IftDay>29+CInt(Mid(thisMonths,tMonth,1))ThenExitFunctionylNewYear=DateSerial(tYear,CInt(Mid(thisMonths,15,2)),CInt(Mid(thisMonths,17,2)))'农历新年日期thisMonths=Left(thisMonths,14)RunYue1=Val("&H"&Right(thisMonths,1))'闰月月份toMonth=tMonth-1IfRunYue1>0Then'有闰月thisMonths=Left(thisMonths,RunYue1)&Mid(thisMonths,13,1)&Mid(thisMonths,RunYue1+1)IftMonth>RunYue1Or(secondMonthAndtMonth=RunYue1)ThentoMonth=tMonthEndIfthisMonths=Left(thisMonths,13)mDays=0Fori=1TotoMonthmDays=mDays+29+CInt(Mid(thisMonths,i,1))NextmDays=mDays+tDayGetDate=ylNewYear+mDays-1

aErr:EndFunction'将压缩的阴历字符还原PrivateFunctionH2B(ByValstrHexAsString)AsStringDimiAsInteger,i1AsInteger,tmpVAsStringConsthStr="0123456789ABCDEF"ConstbStr="0000000100100011010001010110011110001001101010111100110111101111"tmpV=UCase(Left(strHex,3))'十六进制转二进制Fori=1ToLen(tmpV)i1=InStr(hStr,Mid(tmpV,i,1))H2B=H2B&Mid(bStr,(i1-1)*4+1,4)NextH2B=H2B&Mid(strHex,4,2)'十六进制转十进制H2B=H2B&"0"&CStr(Val("&H"&Right(strHex,2)))EndFunction《附录:从网上找到的原代码》'下面是一个关于VB的农历算法

'//日期数据定义方法如下//'前12个字节代表1-12月为大月或是小月,1为大月30天,0为小月29天;'第13位为闰月的情况,1为大月30天,0为小月29天;'第14位为闰月的月份,如果不是闰月为0,否则给出月份(10、11、12分别用A、B、C来表示);'最后4位为当年家农历新年-即农历1月1日所在公历的日期,如0131代表1月31日

FunctionGetYLDate(tYearAsInteger,tMonthAsInteger,tDayAsInteger,YLyearAsString,YLShuXingAsString,OptionalIsGetGlAsBoolean)AsString

'tYear为要输入的年,tMonth为月,tDay为日期;'YLyear是返回值,返回农历的年份,如甲子年;'YLShuXing返回的是属象,如鼠;'IsGetGl是设置是不是通过农历取公历值,如果是前三个返回相应的公历日期,而且返回值是一个公历日期。

OnErrorResumeNext

DimdaList(1900To2011)AsString*18

DimconDateAsDate,setDateAsDate

DimAddMonthAsInteger,AddDayAsInteger,AddYearAsInteger,getDayAsInteger

DimRunYueAsBoolean

IftYear>2010OrtYear<1901ThenExitFunction'如果不是有效有日期,退出

'1900to2011

daList(1900)="010010110110180131"

daList(1901)="010010101110000219"

daList(1902)="101001010111000208"

daList(1903)="010100100110150129"

daList(1904)="110100100110000216"

daList(1905)="110110010101000204"

daList(1906)="011010101010140125"

daList(1907)="010101101010000213"

daList(1908)="100110101101000202"

daList(1909)="010010101110120122"

daList(1910)="010010101110000210"

daList(1911)="101001001101160130"

daList(1912)="101001001101000218"

daList(1913)="110100100101000206"

daList(1914)="110101010100150126"

daList(1915)="101101010101000214"

daList(1916)="010101101010000204"

daList(1917)="100101101101020123"

daList(1918)="100101011011000211"

daList(1919)="010010011011170201"

daList(1920)="010010011011000220"

daList(1921)="101001001011000208"

daList(1922)="101100100101150128"

daList(1923)="011010100101000216"

daList(1924)="011011010100000205"

daList(1925)="101011011010140124"

daList(1926)="001010110110000213"

daList(1927)="100101010111000202"

daList(1928)="010010010111120123"

daList(1929)="010010010111000210"

daList(1930)="011001001011060130"

daList(1931)="110101001010000217"

daList(1932)="111010100101000206"

daList(1933)="011011010100150126"

daList(1934)="010110101101000214"

daList(1935)="001010110110000204"

daList(1936)="100100110111030124"

daList(1937)="100100101110000211"

daList(1938)="110010010110170131"

daList(1939)="110010010101000219"

daList(1940)="110101001010000208"

daList(1941)="110110100101060127"

daList(1942)="101101010101000215"

daList(1943)="010101101010000205"

daList(1944)="101010101101140125"

daList(1945)="001001011101000213"

daList(1946)="100100101101000202"

daList(1947)="110010010101120122"

daList(1948)="101010010101000210"

daList(1949)="101101001010170129"

daList(1950)="011011001010000217"

daList(1951)="101101010101000206"

daList(1952)="010101011010150127"

daList(1953)="010011011010000214"

daList(1954)="101001011011000203"

daList(1955)="010100101011130124"

daList(1956)="010100101011000212"

daList(1957)="101010010101080131"

daList(1958)="111010010101000218"

daList(1959)="011010101010000208"

daList(1960)="101011010101060128"

daList(1961)="101010110101000215"

daList(1962)="010010110110000205"

daList(1963)="101001010111040125"

daList(1964)="101001010111000213"

daList(1965)="010100100110000202"

daList(1966)="111010010011030121"

daList(1967)="110110010101000209"

daList(1968)="010110101010170130"

daList(1969)="010101101010000217"

daList(1970)="100101101101000206"

daList(1971)="010010101110150127"

daList(1972)="010010101101000215"

daList(1973)="101001001101000203"

daList(1974)="110100100110140123"

daList(1975)="110100100101000211"

daList(1976)="110101010010180131"

daList(1977)="101101010100000218"

daList(1978)="101101101010000207"

daList(1979)="100101101101060128"

daList(1980)="100101011011000216"

daList(1981)="010010011011000205"

daList(1982)="101001001011140125"

daList(1983)="101001001011000213"

daList(1984)="1011001001011A0202"

daList(1985)="011010100101000220"

daList(1986)="011011010100000209"

daList(1987)="101011011010060129"

daList(1988)="101010110110000217"

daList(1989)="100100110111000206"

daList(1990)="010010010111150127"

daList(1991)="010010010111000215"

daList(1992)="011001001011000204"

daList(1993)="011010100101030123"

daList(1994)="111010100101000210"

daList(1995)="011010110010180131"

daList(1996)="010110101100000219"

daList(1997)="101010110110000207"

daList(1998)="100100110110150128"

daList(1999)="100100101110000216"

daList(2000)="110010010110000205"

daList(2001)="110101001010140124"

daList(2002)="110101001010000212"

daList(2003)="110110100101000201"

daList(2004)="010110101010120122"

daList(2005)="010101101010000209"

daList(2006)="101010101101170129"

daList(2007)="001001011101000218"

daList(2008)="100100101101000207"

daList(2009)="110010010101150126"

daList(2010)="101010010101000214"

daList(2011)="101101001010000214"

AddYear=tYear

RunYue=False

IfIsGetGlThen

AddMonth=Val(Mid(daList(AddYear),15,2))

AddDay=Val(Mid(daList(AddYear),17,2))

conDate=DateSerial(AddYear,AddMonth,AddDay)

AddDay=tDay

Fori=1TotMonth-1

AddDay=AddDay+29+Val(Mid(daList(tYear),i,1))

Nexti

setDate=DateAdd("d",AddDay-1,conDate)

GetYLDate=setDate

tYear=Year(setDate)

tMonth=Month(setDate)

tDay=Day(setDate)

ExitFunction

EndIf

CHUSHIHUA:

setDate=DateSerial(tYear,tMonth,tDay)

getDay=DateDiff("d",conDate,setDate)

IfgetDay<0ThenAddYear=AddYear-1:GoToCHUSHIHUA

'addday=NearDay

AddDay=1:AddMonth=1

Fori=1TogetDay

AddDay=AddDay+1

IfAddDay=30+Mid(daList(AddYear),AddMonth,1)Or(RunYueAndAddDay=30+Mid(daList(AddYear),13,1))Then

IfRunYue=FalseAndAddMonth=Val("&H"&Mid(daList(AddYear),14,1))Then

RunYue=True

Else

AddMonth=AddMonth+1

AddDay=1

Next

md$="初一初二初三初四初五初六初七初八初九初十十一十二十三十四十五十六十七十八十九二十廿一廿二廿三廿四廿五廿六廿七廿八廿九三十"

dd$=Mid(md$,(AddDay-1)*2+1,2)

mm$=Mid("正二三四五六七八九十寒腊",AddMonth,1)+"月"

YouGetDate=DateSerial(AddYear,AddMonth,AddDay)

tiangan$="甲乙丙丁戊已庚辛壬癸"

dizhi$="子丑寅卯辰巳午未申酉戌亥"

Dimganzhi(0To59)AsString*2

Fori=0To59

ganzhi(i)=Mid(tiangan$,(iMod10)+1,1)+Mid(dizhi$,(iMod12)+1,1)

'ff$=ff$+ganzhi(i)

'MsgBoxff$,,Len(ff$)

YLyear=ganzhi((AddYear-4)Mod60)

shu$="鼠牛虎兔龙蛇马羊猴鸡狗猪"

YLShuXing=Mid(shu$,((AddYear-4)Mod12)+1,1)

IfRunYueThenmm$="闰"+mm$

GetYLDate=mm$+dd$

EndFunction

'下面是一个使用的例子,你需要在窗体上加上一个按扭,并命名为Command1,然后将下列代码复制到窗体的代码中

PrivateSubCommand1_Click()

DimtyAsInteger,tmAsInteger,tdAsInteger,ylAsString,sxAsString

THE END
1.新闻多一度丨龙年龙月龙日龙时再聚首超高“龙含量”怎么算?辰时关于龙年龙月龙日龙时是怎么回事呢?这其实是中国传统计时法中干支纪法和生肖纪法经过转换之后形成的一种说法,就是指辰年、辰月、辰日、辰时,而辰与十二生肖中的龙相配。所以每逢这个时刻就是所谓的龙年龙月龙日龙时了。 干支纪法与天干地支密切相关,什么是干支纪年?天干地支又是如何搭配的?https://www.163.com/dy/article/J0D8N99H0512D3VJ.html
2.国历和农历怎么转换你指的是公历与农历的换算公式吧?这个算法复杂,我可以提供C或C++的API函数给你,不知道你是用什么语言来编的? 7、转换农历国历 网友分享:你好,国历1997.13,转换为农历是1997年1月7日,星星期四;国历1997.1,转换为农历是1996年12月24日,星期六。 8、谁知道生日国历怎么换算成农历? https://www.105188.com/sh/618011.html
3.农历阳历转换阴历转公历查询阴历阳历换算农历知识问答:公历是农历还是阳历?解答:公历是阳历。农历是阳历还是阴历?解答:农历是阴历。 您也可以在『万年历』中查询。如何在万年历进行阴历查阳历:一般阴历日期大概落后阳历日期一个月,比如要查2010年农历四月二十的阳历,翻动万年历,可能在2010年5月或6月的界面找到。 https://m.buyiju.com/cha/yyl.php
4.oracle日历转化成农历你可以参考现有的开源算法,如《中国农历算法》或者网上公开的农历转换库。 另外,压缩包中的"Oracle中如何将日期转换成农历.orasql"文件可能包含了一个已经实现好的转换过程或函数,你可以导入并使用它。导入方法如下: ```sql @$Oracle中如何将日期转换成农历.orasql ``` 导入后,你就可以调用这个函数来转换日期了https://download.csdn.net/download/sjzzhx123123/3859413
5.阳历转化成农历法.docxC++中怎样将阳历转化成农历已关闭20[标签:C++,阳历,农历]小A角、2011-05-0311:06推荐答案一、原理篇公历转换农历的算法公历(GregorianCalendar)与农历(ChineseLunarCalendar)的转换关系不是一个简单的公式就可以完成,其中的转换比较复杂,原因是农历的制定相当复杂,是根据天文观测进行指定的。比较常用并且比较简单的公历转https://m.renrendoc.com/paper/308154963.html
6.python实现的阳历转阴历(农历)算法Flex公历转农历算法 Flex公历转换成农历的类(参考C++版本)。 使用方式: new ChineseDate(new Date()).date 输出公历日期对应的农历格式。 上传者:liu_you时间:2009-12-25 Python实现公历(阳历)转农历(阴历)的方法示例 本文实例讲述了Python实现公历(阳历)转农历(阴历)的方法。分享给大家供大家参考,具体如下: 两https://www.iteye.com/resource/weixin_38721119-13777616
7.php怎么将农历转换成公历?Worktile社区这段代码实现了将农历日期转换为公历日期的功能。你只需要将需要转换的农历日期的年、月、日作为参数传入函数`lunarToSolar()`,就可以得到对应的公历日期。需要注意的是,这里只示范了部分农历日期的转换规则,你需要根据实际情况进行相应的计算。 下面是将农历转换成公历的步骤和方法: https://worktile.com/kb/ask/180274.html
8.一种公历到农历日期转换算法的实现本文主要从单片机软件实现角度介绍一种公历到农历转换的算法思想, 算法采用MCS-51 指令系统实现。并给出程序流程图,另外对二十四节气和生肖的算法也做详细介绍。关键词:单片机;MCS-51 指令系统Abstract: This paper introduces the realization and algorithm of the transform between Gregorian calendar and lunar https://m.elecfans.com/article/39160.html
9.免费阴历阳历转换在线工具网(zxgj.cn)阴历阳历转换免费 已经有11.2w+人使用8人评论 HR 在线人才测评系统心理疾病精神疾病筛查人格障碍测试PDQ量表测试你的智商高低 公历转农历,阳历转阴历 请输入公历(阳历)日期 19401941194219431944194519461947194819491950195119521953195419551956195719581959196019611962196319641965196619671968196919701971197219731974197519761977197819791980198119821983198https://www.zxgj.cn/g/yinyangli
10.Python实现公历(阳历)转农历(阴历)的方法示例python这篇文章主要介绍了Python实现公历(阳历)转农历(阴历)的方法,涉及农历算法原理及Python日期运算相关操作技巧,需要的朋友可以参考下 本文实例讲述了Python实现公历(阳历)转农历(阴历)的方法。分享给大家供大家参考,具体如下: 两个要点: 1、公历转农历用了查表法(第126行) https://www.jb51.net/article/121808.htm
11.怎样将公历年号转换成农历年号?怎样将公历年号转换成农历年号? ①将公历年号减去3,除以60。显然,余数是小于60的两位数。 ②余数的个位数1~9对应天干“甲乙丙丁戊己庚辛壬”,0对应“癸”。 ③余数再除以12,得到的余数,对应“地支”的12个字:子丑寅卯辰巳午未申酉戌亥(0对应亥)。 https://www.meipian.cn/4oo74h28
12.农历公历转换阴历转阳历 请输入农历(阴历)日期: 年月日 农历是中国传统历法,现在生活中一般俗称阴历(太阴历-按月亮月相周期变化计算的历法)。阳历为太阳历,以地球公转周期计算的历法,公历就是一种太阳历。公历是现今世界通行的历法,即公历纪元、亦称西历,西元、公元等。https://t.aies.cn/shijian/nongli/
13.WPS表格怎么将公历转化成阴历日&#x019C;以上就是将公历日期转换为阴历日期的方法。希望能对您有所帮助! 有用(0) 回复 sharpsword666 在WPS EXCEL中已试过了所有公式,都无法将公历日转化成农历日,到底什么原因呢? 有用(0) 回复 948186579 方法:1、在同一单元格插入多个日期:需要逐个输入2、不同单元格间输入多个日期:输入当天日期:+today(),固定https://wap.zol.com.cn/ask/x_20332058.html