1900-2100公历年以查表方式取农历二十四节气(VBA)

在前两天，发了一段农历转公历的代码，今天再把获取二十四节气的代码给完成了。

同样，基础数据及参照代码来自：http://s.o4u.com/host/blog/calendar/calendar.htm

前提：

农历二十节气，以地球绕太阳公转轨迹，以15度均匀分割，在1900~2100这个时间段，有以下规律：

1.每公历月份，都有两个节气，分别在月首及月尾

2.每个节气在月内与基准日期相差的天数为0-3天

3.在1900~2100这201年，节气的分布种类共有69种

以上是由数据总结出来的，可以由此生成编程所需的数据，如下：（注：本数据由来源地址的代码中转换而来）

    ' 二十四节气在各月的基准日期solarTermBase = Array(4, 19, 3, 18, 4, 19, 4, 19, 4, 20, 4, 20, 6, 22, 6, 22, 6, 22, 7, 22, 6, 21, 6, 21)' 二十四节气以年为单位，在1900-2100年间，共有69种分布种类，一个长整型存储12个节气与基准日的天数差额，共2*69项(每2bit表示一个节气的天数差，0-3天，高8位置0)solarTermOS = Array( _&H95A59A, &H599AA5, &HA5A6AA, &H9AAAA9, &HA9AAAE, &HAAAAAA, &HAAFAEE, &HAEEAAA, &HEAA59A, &H599AA5, &HA9AAAA, &HAAAAAA, &HEAA59A, &H599A95, &H95A6AA, &H9A9AA9, _&HA5A6AA, &HAAAAAA, &HAABAAE, &HAAEAAA, &HAAA59A, &H599695, &H95A69A, &H9A9AA9, &HA5A6AA, &HAAAAA9, &H95A59A, &H9A9AA5, &HA9AAAE, &HAAEAAA, &HAAA59A, &H599555, _&HAAA599, &H599555, &HAAA559, &H599555, &H95A59A, &H599695, &HAA6559, &H559555, &H55A59A, &H599695, &H95A59A, &H9A9AA9, &HAA5559, &H559555, &HA95559, &H555555, _&H55A599, &H599555, &HA95555, &H555555, &H55A559, &H599555, &HA5A6AA, &H9A9AA9, &HA95155, &H555555, &H55A559, &H559555, &H95A59A, &H5996A5, &HA55155, &H455555, _&H556559, &H559555, &H95A59A, &H5A9AA5, &HA55155, &H455554, &H555559, &H555555, &H55A599, &H599695, &H545559, &H555555, &H545555, &H595555, &H545555, &H555555, _&HA55155, &H454554, &H545155, &H555555, &HA55145, &H454554, &H545155, &H455555, &H955045, &H454554, &H505155, &H455555, &H955045, &H44554, &H505155, &H455554, _&H955045, &H44550, &H505145, &H454554, &H955045, &H44150, &H505045, &H454554, &H955044, &H44140, &H405045, &H44554, &H555044, &H44140, &H555555, &H555555, _&H405045, &H44550, &H555044, &H44000, &H555004, &H4000&, &H405045, &H44150, &H505045, &H54554, &H405044, &H44140, &H505045, &H44554, &H550004, &H0&, _&H5044&, &H44140, &H550000, &H0&, &H5044&, &H44000, &H540000, &H0&, &H5044&, &H4000&)' 1900-2100各年的二十四节气分布种类，对应上表中的序号，一个长整型保存4年序号，每8bit一个序号（序号=0-68)solarTermIdx = Array( _&H10203, &H4010503, &H4010503, &H6070809, &HA0B0C09, &HA0D0C0E, &HA0D010E, &HF000102, &H10000105, &H10000105, _&H10000105, &H11120708, &H13141508, &H13140D01, &H16140001, &H17180001, &H17180001, &H19180001, &H191A001B, &H1C1D1E0B, _&H1C1D1215, &H1F201421, &H22232400, &H22251800, &H22261800, &H22271800, &H22271D00, &H28291D1E, &H2A2B1D12, &H2C2D2024, _&H2E2F2324, &H302F2718, &H302F2718, &H302F271D, &H302F271D, &H3031291D, &H32332B1D, &H34352D23, &H36352D37, &H36382F37, _&H39382F27, &H39382F27, &H3A383127, &H3A3B312B, &H3A3B3C2B, &H3A3D3E2D, &H3F40352D, &H4140382F, &H4142382F, &H4344382F, _&H27000000)

有了数据后，编码是非常简单的，只要由年份确定该年的二十节气分布种类，是69种里面的哪一种（查表方式），取出分布种类的定义信息后，再取某节气的偏差天数。最终返回基准天数 + 偏差天数即可。

代码比较简单，不再作详解（在参考代码里，用JS实现的代码，本函数只有一句代码）

附示例代码（在上次的代码基础上，加了公历转农历的方法，但请注意，目前尚未处理公历1900/1/1~农历1900/1/1之间的数据，因为参考代码中，信息表中未包含这段信息）：

农历日期数据类型定义：

Option ExplicitType LunarDateyear As Long                '农历年份(西历纪年1900-2100)month As Integer            '农历月份(1-12)day As Integer              '农历日期(1-30)isLeap As Boolean           '是否为闰月年(True=有闰月  Flas=无闰月)solarIndex As Integer       '二十四节气(0-24) 0=当日没有节气
End Type

'
'根据农历年月日取对应公历日期 类模块
'                                    (By 漠石 mostone@hotmail.com)
'
'  本类只有一个公用方法：
'    Public Function GetDateFromLunar(y As Long, m As Long, d As Long, Optional isLeap As Boolean = False) As Date
'    y: 1900 - 2100 200年
'    m: 1 - 12 月份
'    d: 1 - 30，如果是小月，并且传入了30，则返回下一农历月第一天的公历
'    isLeap: 是否为闰月
'
'==========================================================================================
'  注：本模块的数据及代码参照自：http://s.o4u.com/host/blog/calendar/calendar.htm
'      以下为原作者信息：
'        ***************************************
'         農曆月曆&世界時間 DHTML 程式 (台灣版)
'        ***************************************
'             最後修改: 2009 年 3 月 20 日
'
'
'如果您覺得這個程式不錯，您可以自由轉寄給親朋好友分享。自由使
'用範圍: 學校、學會、公會、公司內部、程式研究、個人網站供人查
'詢使用?
'
'Open Source 不代表放棄著作權，任何形式之引用或轉載前請來信告
'知。如需於「商業或營利」目的中使用此部份之程式碼或資料，需取
'得本人書面授權。
'
'最新版本與更新資訊於 http://sean.o4u.com/ap/calendar/ 公佈
'
'
'　                            歡迎來信互相討論研究與指正誤謬
'                     連絡方式：http://sean.o4u.com/contact/
'                                          Sean Lin(林洵賢)
'                          尊重他人創作?請勿刪除或變更此說明Option ExplicitPrivate compressLunarInfo As Variant
Private solarTermBase As Variant, solarTermOS As Variant, solarTermIdx As Variant
Private dateOfLunarYearBegin() As DatePrivate Const LUNAR_YEAR_START As Long = 1900
Private Const LUNAR_YEAR_END As Long = 2100
Private Const FL_M As Integer = 1
Private Const FL_D As Integer = 31'#### 根据农历年月日返回公历日期
Public Function GetGregorian(ByVal y As Long, ByVal m As Long, ByVal d As Long, Optional ByVal isLeap As Boolean = False) As DateDim sum As Long, leapMonth As IntegerIf y < LUNAR_YEAR_START Or y > LUNAR_YEAR_END ThenErr.Raise Number:=6, DESCRIPTION:="只接受 " & LUNAR_YEAR_START & " - " & LUNAR_YEAR_END & " 之间的年份"Exit FunctionEnd IfIf m < 1 Or m > 12 ThenErr.Raise Number:=7, DESCRIPTION:="只接受 1 - 12 之间的月份"Exit FunctionEnd IfIf d < 1 Or d > 30 ThenErr.Raise Number:=8, DESCRIPTION:="只接受 1 - 30 之间的日期"Exit FunctionEnd IfIf Not isLeap Thensum = GetMultiLunarMonthDays(y, m - 1) + d - 1ElseleapMonth = GetLeapMonth(y)If leapMonth <> m ThenErr.Raise Number:=9, DESCRIPTION:="不是闰月"Exit FunctionEnd Ifsum = GetMultiLunarMonthDays(y, m) + d - 1End If' 年初日期 + 偏移天数GetGregorian = DateAdd("d", sum, dateOfLunarYearBegin(y - LUNAR_YEAR_START))
End Function'#### 返回 y 年第 n 个节气的日期（4-25） y=1900-2100, n=1-24
Public Function GetSolarTerm(ByVal y As Long, ByVal n As Integer) As IntegerDim i As Integer, idxIndex As Integer, idxOffset As Integer, mask As Long, OSIndex As Long, OSValue As Long, OSOffset As IntegerIf y < LUNAR_YEAR_START Or y > LUNAR_YEAR_END ThenErr.Raise Number:=6, DESCRIPTION:="只接受 " & LUNAR_YEAR_START & " - " & LUNAR_YEAR_END & " 之间的年份"Exit FunctionEnd IfIf n < 1 Or n > 24 ThenErr.Raise Number:=10, DESCRIPTION:="只接受 1 - 24 之间的节气序号"Exit FunctionEnd IfidxIndex = (y - LUNAR_YEAR_START) \ 4idxOffset = (y - LUNAR_YEAR_START) Mod 4mask = &H7F&' 每 step 向左移 8 位For i = 1 To 3 - idxOffsetmask = mask * &H100Next iOSIndex = solarTermIdx(idxIndex) And mask' 每 step 向右移 8 位For i = 1 To 3 - idxOffsetOSIndex = OSIndex / &H100Next iIf n <= 12 ThenOSValue = solarTermOS(OSIndex * 2)OSOffset = nElseOSValue = solarTermOS(OSIndex * 2 + 1)OSOffset = n - 12End Ifmask = &H3&' 每 step 向右移 2 位For i = OSOffset To 11mask = mask * &H4Next iOSValue = OSValue And mask' 每 step 向左移 2 位For i = OSOffset To 11OSValue = OSValue / &H4Next i' 基准日期 + 偏差天数GetSolarTerm = OSValue + solarTermBase(n - 1)
End Function'#### 传入公历日期，返回农历日期 (公历1900/1/1~农历1900/1/1之间的日期尚待处理）
Public Function GetLunar(ByVal dt As Date) As LunarDateDim result As LunarDateDim lunarYearFirstDay As Date, mask As Long, i As IntegerDim y As Integer, daysOfMonth As Integer, leapMonth As Integer, gregorianDay As Integer, n As Integery = DatePart("yyyy", dt)If y < LUNAR_YEAR_START Or y > LUNAR_YEAR_END ThenErr.Raise Number:=6, DESCRIPTION:="只接受 " & LUNAR_YEAR_START & " - " & LUNAR_YEAR_END & " 之间的公历日期"Exit FunctionEnd IflunarYearFirstDay = dateOfLunarYearBegin(y - LUNAR_YEAR_START)If lunarYearFirstDay > dt Thenresult.year = y - 1lunarYearFirstDay = dateOfLunarYearBegin(result.year - LUNAR_YEAR_START)Elseresult.year = yEnd Ifresult.day = DateDiff("d", lunarYearFirstDay, dt) + 1leapMonth = GetLeapMonth(result.year)mask = &H8000&For i = 1 To 12' 正常月份daysOfMonth = GetLunarMonthDays(result.year, mask)If result.day > daysOfMonth Thenresult.day = result.day - daysOfMonthElseresult.month = iExit ForEnd If' 闰月If leapMonth = i ThendaysOfMonth = GetLeapDays(result.year)If result.day > daysOfMonth Thenresult.day = result.day - daysOfMonthElseresult.month = iresult.isLeap = TrueExit ForEnd IfEnd Ifmask = mask / 2Next i' 二十四节气n = (DatePart("m", dt) - 1) * 2gregorianDay = DatePart("d", dt)If gregorianDay > 15 Thenn = n + 2Elsen = n + 1End IfIf GetSolarTerm(y, n) = gregorianDay Thenresult.solarIndex = nElseresult.solarIndex = 0End IfGetLunar = result
End Function'#### 类初始化，数据准备
Private Sub Class_Initialize()Dim i As Integer, itemCount As Integer, sum As LongcompressLunarInfo = Array( _&H4BD8&, &H4AE0&, &HA570&, &H54D5&, &HD260&, &HD950&, &H5554&, &H56AF&, &H9AD0&, &H55D2&, _&H4AE0&, &HA5B6&, &HA4D0&, &HD250&, &HD295&, &HB54F&, &HD6A0&, &HADA2&, &H95B0&, &H4977&, _&H497F&, &HA4B0&, &HB4B5&, &H6A50&, &H6D40&, &HAB54&, &H2B6F&, &H9570&, &H52F2&, &H4970&, _&H6566&, &HD4A0&, &HEA50&, &H6A95&, &H5ADF&, &H2B60&, &H86E3&, &H92EF&, &HC8D7&, &HC95F&, _&HD4A0&, &HD8A6&, &HB55F&, &H56A0&, &HA5B4&, &H25DF&, &H92D0&, &HD2B2&, &HA950&, &HB557&, _&H6CA0&, &HB550&, &H5355&, &H4DAF&, &HA5B0&, &H4573&, &H52BF&, &HA9A8&, &HE950&, &H6AA0&, _&HAEA6&, &HAB50&, &H4B60&, &HAAE4&, &HA570&, &H5260&, &HF263&, &HD950&, &H5B57&, &H56A0&, _&H96D0&, &H4DD5&, &H4AD0&, &HA4D0&, &HD4D4&, &HD250&, &HD558&, &HB540&, &HB6A0&, &H95A6&, _&H95BF&, &H49B0&, &HA974&, &HA4B0&, &HB27A&, &H6A50&, &H6D40&, &HAF46&, &HAB60&, &H9570&, _&H4AF5&, &H4970&, &H64B0&, &H74A3&, &HEA50&, &H6B58&, &H5AC0&, &HAB60&, &H96D5&, &H92E0&, _&HC960&, &HD954&, &HD4A0&, &HDA50&, &H7552&, &H56A0&, &HABB7&, &H25D0&, &H92D0&, &HCAB5&, _&HA950&, &HB4A0&, &HBAA4&, &HAD50&, &H55D9&, &H4BA0&, &HA5B0&, &H5176&, &H52BF&, &HA930&, _&H7954&, &H6AA0&, &HAD50&, &H5B52&, &H4B60&, &HA6E6&, &HA4E0&, &HD260&, &HEA65&, &HD530&, _&H5AA0&, &H76A3&, &H96D0&, &H4AFB&, &H4AD0&, &HA4D0&, &HD0B6&, &HD25F&, &HD520&, &HDD45&, _&HB5A0&, &H56D0&, &H55B2&, &H49B0&, &HA577&, &HA4B0&, &HAA50&, &HB255&, &H6D2F&, &HADA0&, _&H4B63&, &H937F&, &H49F8&, &H4970&, &H64B0&, &H68A6&, &HEA5F&, &H6B20&, &HA6C4&, &HAAEF&, _&H92E0&, &HD2E3&, &HC960&, &HD557&, &HD4A0&, &HDA50&, &H5D55&, &H56A0&, &HA6D0&, &H55D4&, _&H52D0&, &HA9B8&, &HA950&, &HB4A0&, &HB6A6&, &HAD50&, &H55A0&, &HABA4&, &HA5B0&, &H52B0&, _&HB273&, &H6930&, &H7337&, &H6AA0&, &HAD50&, &H4B55&, &H4B6F&, &HA570&, &H54E4&, &HD260&, _&HE968&, &HD520&, &HDAA0&, &H6AA6&, &H56DF&, &H4AE0&, &HA9D4&, &HA4D0&, &HD150&, &HF252&, _&HD520&)' 取得各农历年的正月初一的公历日期itemCount = UBound(compressLunarInfo)ReDim dateOfLunarYearBegin(itemCount)dateOfLunarYearBegin(0) = DateSerial(LUNAR_YEAR_START, FL_M, FL_D)For i = 0 To itemCount - 1sum = GetMultiLunarMonthDays(i + LUNAR_YEAR_START, 12)dateOfLunarYearBegin(i + 1) = DateAdd("d", sum, dateOfLunarYearBegin(i))'Debug.Print (i + LUNAR_YEAR_START + 1) & "年正月初一的公历日期：" & vbTab & dateOfLunarYearBegin(i + 1)Next i' 二十四节气在各月的基准日期solarTermBase = Array(4, 19, 3, 18, 4, 19, 4, 19, 4, 20, 4, 20, 6, 22, 6, 22, 6, 22, 7, 22, 6, 21, 6, 21)' 二十四节气以年为单位，在1900-2100年间，共有69种分布种类，一个长整型存储12个节气与基准日的天数差额，共2*69项(每2bit表示一个节气的天数差，0-3天，高8位置0)solarTermOS = Array( _&H95A59A, &H599AA5, &HA5A6AA, &H9AAAA9, &HA9AAAE, &HAAAAAA, &HAAFAEE, &HAEEAAA, &HEAA59A, &H599AA5, &HA9AAAA, &HAAAAAA, &HEAA59A, &H599A95, &H95A6AA, &H9A9AA9, _&HA5A6AA, &HAAAAAA, &HAABAAE, &HAAEAAA, &HAAA59A, &H599695, &H95A69A, &H9A9AA9, &HA5A6AA, &HAAAAA9, &H95A59A, &H9A9AA5, &HA9AAAE, &HAAEAAA, &HAAA59A, &H599555, _&HAAA599, &H599555, &HAAA559, &H599555, &H95A59A, &H599695, &HAA6559, &H559555, &H55A59A, &H599695, &H95A59A, &H9A9AA9, &HAA5559, &H559555, &HA95559, &H555555, _&H55A599, &H599555, &HA95555, &H555555, &H55A559, &H599555, &HA5A6AA, &H9A9AA9, &HA95155, &H555555, &H55A559, &H559555, &H95A59A, &H5996A5, &HA55155, &H455555, _&H556559, &H559555, &H95A59A, &H5A9AA5, &HA55155, &H455554, &H555559, &H555555, &H55A599, &H599695, &H545559, &H555555, &H545555, &H595555, &H545555, &H555555, _&HA55155, &H454554, &H545155, &H555555, &HA55145, &H454554, &H545155, &H455555, &H955045, &H454554, &H505155, &H455555, &H955045, &H44554, &H505155, &H455554, _&H955045, &H44550, &H505145, &H454554, &H955045, &H44150, &H505045, &H454554, &H955044, &H44140, &H405045, &H44554, &H555044, &H44140, &H555555, &H555555, _&H405045, &H44550, &H555044, &H44000, &H555004, &H4000&, &H405045, &H44150, &H505045, &H54554, &H405044, &H44140, &H505045, &H44554, &H550004, &H0&, _&H5044&, &H44140, &H550000, &H0&, &H5044&, &H44000, &H540000, &H0&, &H5044&, &H4000&)' 1900-2100各年的二十四节气分布种类，对应上表中的序号，一个长整型保存4年序号，每8bit一个序号（序号=0-68)solarTermIdx = Array( _&H10203, &H4010503, &H4010503, &H6070809, &HA0B0C09, &HA0D0C0E, &HA0D010E, &HF000102, &H10000105, &H10000105, _&H10000105, &H11120708, &H13141508, &H13140D01, &H16140001, &H17180001, &H17180001, &H19180001, &H191A001B, &H1C1D1E0B, _&H1C1D1215, &H1F201421, &H22232400, &H22251800, &H22261800, &H22271800, &H22271D00, &H28291D1E, &H2A2B1D12, &H2C2D2024, _&H2E2F2324, &H302F2718, &H302F2718, &H302F271D, &H302F271D, &H3031291D, &H32332B1D, &H34352D23, &H36352D37, &H36382F37, _&H39382F27, &H39382F27, &H3A383127, &H3A3B312B, &H3A3B3C2B, &H3A3D3E2D, &H3F40352D, &H4140382F, &H4142382F, &H4344382F, _&H27000000)End Sub'#### 取得 y 年从农历正月初一到 m 月月底的总天数
Private Function GetMultiLunarMonthDays(y As Long, m As Long) As LongDim i As Integer, mask As Long, sum As Long, leapMonth As IntegerIf m < 1 ThenGetMultiLunarMonthDays = 0Exit FunctionEnd Ifmask = &H8000&sum = 0i = 1' 各正常月份天数累加While (i <= m) And (mask > &H8)sum = sum + GetLunarMonthDays(y, mask)mask = mask / 2i = i + 1Wend' 闰月天数累加leapMonth = GetLeapMonth(y)If leapMonth > 0 And leapMonth < m Thensum = sum + GetLeapDays(y)End IfGetMultiLunarMonthDays = sum
End Function'#### 返回 y 年指定月份的天数
Private Function GetLunarMonthDays(y As Long, ByVal mask As Long) As LongIf (compressLunarInfo(y - LUNAR_YEAR_START) And mask) = mask ThenGetLunarMonthDays = 30ElseGetLunarMonthDays = 29End If
End Function'#### 返回 y 年闰月的天数
Private Function GetLeapDays(y As Long) As LongIf (compressLunarInfo(y - LUNAR_YEAR_START + 1) And &HF) = &HF ThenGetLeapDays = 30ElseGetLeapDays = 29End If
End Function'#### 返回 y 年闰月的月份，1-12，没闰传回 0
Private Function GetLeapMonth(y As Long) As LongDim leapMonth As LongleapMonth = (compressLunarInfo(y - LUNAR_YEAR_START) And &HF)If leapMonth = &HF ThenGetLeapMonth = 0ElseGetLeapMonth = leapMonthEnd If
End Function

1900-2100公历年以查表方式取农历二十四节气(VBA)相关推荐

MCS51流水灯_查表方式1_Proteus仿真
MCS51流水灯硬件连接: 程序1: ORG 10 START:MOV P0,#0FFHCLR P0.0LCALL DealySETB P0.0LCALL DealyCLR P0.1LCALL De ...
YUV转RGB查表方式的代码
YUV格式画面可以出来.如果是其他的YUV格式,颜色会有问题.性能并不象预料中的那样. static int Table_fv1[] = {-180, -179, -177, -176, -174, ...
crc16 c语言非查表,CRC16CCITT(1021)的16字表长查表程序
CRC位域4单表查表及建表原则: 左移位域4取列表16个,大端存储模式.右移位域4取行表16个,小端存储模式. 在CRC16CCITT中CRC的多项式为:左移CRC16=X16+X12+X5+1,即权 ...
#八、古老的查表计算器－－图表
图表,一般称作江恩图表.这是由于江恩在股市的使用,使其受到关注.实际其产生年代应在古希腊或古罗马时期(笔者根据数学史的逻辑推理,无考古证据),只是这些图表是当年最高的数学水平的产物之一,在西方被隐秘传 ...
高效查表判断胡牌算法的lua版本
来源于日本论坛的一套用于麻将的判断胡牌算法,运用查表方式实现.原文链接(http://hp.vector.co.jp/authors/VA046927/mjscore/mjalgorism.html) ...
crc16 ibm c语言,CRC16IBM(A001)的16字表长查表程序
本帖最后由 hotpower 于 2009-10-18 19:10 编辑此文依据: http://blog.ednchina.com/hotpower/272834/message.aspx CRC ...
FPGA(四)：FPGA通过查表的方式生成正弦波
这里通过两种方式来实现FPGA查表生成正弦波先看图这是FPGA通过查ROM表生成正弦波的原理下面开始介绍具体实现方法: 这里我使用的开发板是MAX10 10M50DAFC7G,不同的开发板接口可 ...
编程示例：以人名为输入判断性别的函数以查表的方式实现
编程示例:以人名为输入判断性别的函数以查表的方式实现需求分析:功能是根据输入的人名,来判断人名的男女的可能性.限定条件是中国的汉族的人名. 格式如下: 输入是"孙机苏东海 ...
农历公历万年历互查系统
此文章来源:http://www.k369.com/qt/cx/nongli.htm 此文件为html文件,因为javaeye设置了关键词禁用,里面的"毛领导"用的时候应作修改. ...

1900-2100公历年以查表方式取农历二十四节气(VBA)

1900-2100公历年以查表方式取农历二十四节气(VBA)相关推荐

最新文章

热门文章