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

803 461

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

农历公历转换农历转公历农历查公历

农历阳历转换器运势

阴历阳历转换时间为何如此精准

新闻多一度丨龙年龙月龙日龙时再聚首超高“龙含量”怎么算？辰时子月地支天干李龙日足球运动员

公历转农历算法怎么算？

农历怎么查星座最准确(掌握农历转换方法准确查找星座)

公历和农历的区别公历和农历的转换

python实现的阳历转阴历（农历）算法Python教程

公历转农历

农历是阴历还是阳历怎么算的

日历转农历查询,农历生日计算器

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

1.公历转农历生肖干支纪年节气算法研究和C程序实现农历的那些事儿(一) 香港天文台农历数据(txt版) 香港天文台农历数据(pdf版) 二、关于农历 查阅了大量关于公历转农历的博文之后,明确了:所谓的公历转农历算法即系基于查表法推算。因为农历无明显规律,数据需要天文台观测得到,因此无法用公式将公历转成农历。 https://blog.csdn.net/Stack_/article/details/119980697
2.中国农历年份,rpa,机器人,自动化路人甲中国农历公历转换 阴阳历换算 万年历 农历是我国古代用以指导农业生产生活的传统历法,自夏朝始,称为夏历。 农历属于一种阴阳历,是以月球绕地球一周为一月,十二月为一年,月亮号为太阴,故谓之太阴历,简称 rpatu更多内容请查看https://passer-by.com/calendar/ https://wdlinux.cn/html/zonghe/20241128/20015.html
3.国历和农历怎么转换6、国历与农历的换算公式 求教高人!!! 你指的是公历与农历的换算公式吧?这个算法复杂,我可以提供C或C++的API函数给你,不知道你是用什么语言来编的? 7、转换农历国历 网友分享:你好,国历1997.13,转换为农历是1997年1月7日,星星期四;国历1997.1,转换为农历是1996年12月24日,星期六。 https://www.105188.com/sh/618011.html
4.公历换成农历的算法理想股票技术论坛学习如何将公历日期转换为农历日期的算法和计算方法,了解如何精确地进行公历和农历之间的转换操作。 ,理想股票技术论坛https://www.55188.com/misc.php?mod=tag&id=7110123
5.python实现的阳历转阴历(农历)算法上午上传的公历转换农历的代码界面不太好看,下午的时候重新修改了下,再上传一次。有需要请下载查看。 上传者:tfs080640234时间:2015-03-24 Flex公历转农历算法 Flex公历转换成农历的类(参考C++版本)。 使用方式: new ChineseDate(new Date()).date 输出公历日期对应的农历格式。 https://www.iteye.com/resource/weixin_38721119-13777616
6.公历和农历转换算法详解1、公历和农历转换算法详解/C51 写的公历转农历和星期#define uchar unsigned char#define uint unsigned int #include <intrins.h> /*公历年对应的农历数据 ,每年三字节 ,格式第一字节 BIT7-4 位表示闰月月份 , 值为 0 为无闰月 ,BIT3-0 对应农历第 1-4 月的大小 第二字节 BIT7-0 对应农历第 5-12https://www.renrendoc.com/paper/162876439.html
7.公历和农历转换算法详解20220811090641.docxPAGE PAGE 10 公历和农历转换算法详解 //C51写的公历转农历和星期#define uchar unsigned char #define uint unsigned int #include intrins.h /* 公历年对应的农历数据,每年三字节, 格式第一字节BIT7-4 位表示闰月月份,值为 0 为无闰月,BIT3-0 对应农历第 1-4 月的大小第二字节BIT7-0 对应农历第 5-https://max.book118.com/html/2022/0811/6231111230004222.shtm
8.Lua公历转农历算法绿色冰点中国以农业立国,夏历的节气时令等与农业生产密切相关,民国建立后,通用阳历,而将传统的夏历称为农历。一般意义上讲,阴历即是农历。 在lua编程中需要用到公历转换为农历的算法,这里根据c++的算法翻译了一个,发布出来,提供给有需要的Luaer使用 该算法以1921年正月初一作为初始时间开始计算,所以早于该天的计算就不准了https://www.cnblogs.com/moodlxs/archive/2013/01/21/2870030.html
9.一种公历到农历日期转换算法的实现本文主要从单片机软件实现角度介绍一种公历到农历转换的算法思想, 算法采用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
10.在VB6中实现公历农历转换9高牧原;话说“公历”和“农历”[J];少年天地;2003年Z1期 10郑丽丽,谢磊,李清宝一种公历到农历日期转换算法的实现[J];微计算机信息;2005年10期 11抱雪公历转换农历的算法及其JavaScript实现[J];电脑爱好者;2001年16期 12公历(阳历)、夏历(农历)和阴历[J];党政干部文摘;2002年06期 https://www.cnki.com.cn/Article/CJFDTotal-DNAH200214094.htm
11.Python实现公历(阳历)转农历(阴历)的方法示例python这篇文章主要介绍了Python实现公历(阳历)转农历(阴历)的方法,涉及农历算法原理及Python日期运算相关操作技巧,需要的朋友可以参考下 本文实例讲述了Python实现公历(阳历)转农历(阴历)的方法。分享给大家供大家参考,具体如下: 两个要点: 1、公历转农历用了查表法(第126行) https://www.jb51.net/article/121808.htm
12.万年历农历转阳历js方法阳历转农历农历转阳历java年历的计算方法:关键是求出当年1月1日是星期几。书上给出了当年份Y>。发现节气与农历月之间,“银盘子”是民间术士创造的万年历速算法。五日十时交白. 星期六阴历和阳历的区别和关系: 阳历也就是公历,它是国际通用的。阳历以地球绕太阳转一圈的时间定做一年,共36https://cloud.tencent.com/developer/information/%E4%B8%87%E5%B9%B4%E5%8E%86%E5%86%9C%E5%8E%86%E8%BD%AC%E9%98%B3%E5%8E%86%20js%20%E6%96%B9%E6%B3%95
13.免费阴历阳历转换在线工具网(zxgj.cn)阴历阳历转换免费 已经有11.2w+人使用8人评论 HR 在线人才测评系统心理疾病精神疾病筛查人格障碍测试PDQ量表测试你的智商高低 公历转农历,阳历转阴历 请输入公历(阳历)日期 19401941194219431944194519461947194819491950195119521953195419551956195719581959196019611962196319641965196619671968196919701971197219731974197519761977197819791980198119821983198https://www.zxgj.cn/g/yinyangli