在前两天，发了一段农历转公历的代码，今天再把获取二十四节气的代码给完成了。
同样，基础数据及参照代码来自：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 LunarDate year 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 VariantPrivate solarTermBase As Variant, solarTermOS As Variant, solarTermIdx As VariantPrivate dateOfLunarYearBegin() As DatePrivate Const LUNAR_YEAR_START As Long = 1900Private Const LUNAR_YEAR_END As Long = 2100Private Const FL_M As Integer = 1Private 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 Date Dim sum As Long, leapMonth As Integer If y < LUNAR_YEAR_START Or y > LUNAR_YEAR_END Then Err.Raise Number:=6, DESCRIPTION:="只接受 " & LUNAR_YEAR_START & " - " & LUNAR_YEAR_END & " 之间的年份" Exit Function End If If m < 1 Or m > 12 Then Err.Raise Number:=7, DESCRIPTION:="只接受 1 - 12 之间的月份" Exit Function End If If d < 1 Or d > 30 Then Err.Raise Number:=8, DESCRIPTION:="只接受 1 - 30 之间的日期" Exit Function End If If Not isLeap Then sum = GetMultiLunarMonthDays(y, m - 1) + d - 1 Else leapMonth = GetLeapMonth(y) If leapMonth <> m Then Err.Raise Number:=9, DESCRIPTION:="不是闰月" Exit Function End If sum = GetMultiLunarMonthDays(y, m) + d - 1 End If ' 年初日期 + 偏移天数 GetGregorian = DateAdd("d", sum, dateOfLunarYearBegin(y - LUNAR_YEAR_START))End Function'#### 返回 y 年第 n 个节气的日期（4-25） y=1900-2100, n=1-24Public Function GetSolarTerm(ByVal y As Long, ByVal n As Integer) As Integer Dim i As Integer, idxIndex As Integer, idxOffset As Integer, mask As Long, OSIndex As Long, OSValue As Long, OSOffset As Integer If y < LUNAR_YEAR_START Or y > LUNAR_YEAR_END Then Err.Raise Number:=6, DESCRIPTION:="只接受 " & LUNAR_YEAR_START & " - " & LUNAR_YEAR_END & " 之间的年份" Exit Function End If If n < 1 Or n > 24 Then Err.Raise Number:=10, DESCRIPTION:="只接受 1 - 24 之间的节气序号" Exit Function End If idxIndex = (y - LUNAR_YEAR_START) \ 4 idxOffset = (y - LUNAR_YEAR_START) Mod 4 mask = &H7F& ' 每 step 向左移 8 位 For i = 1 To 3 - idxOffset mask = mask * &H100 Next i OSIndex = solarTermIdx(idxIndex) And mask ' 每 step 向右移 8 位 For i = 1 To 3 - idxOffset OSIndex = OSIndex / &H100 Next i If n <= 12 Then OSValue = solarTermOS(OSIndex * 2) OSOffset = n Else OSValue = solarTermOS(OSIndex * 2 + 1) OSOffset = n - 12 End If mask = &H3& ' 每 step 向右移 2 位 For i = OSOffset To 11 mask = mask * &H4 Next i OSValue = OSValue And mask ' 每 step 向左移 2 位 For i = OSOffset To 11 OSValue = OSValue / &H4 Next i ' 基准日期 + 偏差天数 GetSolarTerm = OSValue + solarTermBase(n - 1)End Function'#### 传入公历日期，返回农历日期 (公历1900/1/1~农历1900/1/1之间的日期尚待处理）Public Function GetLunar(ByVal dt As Date) As LunarDate Dim result As LunarDate Dim lunarYearFirstDay As Date, mask As Long, i As Integer Dim y As Integer, daysOfMonth As Integer, leapMonth As Integer, gregorianDay As Integer, n As Integer y = DatePart("yyyy", dt) If y < LUNAR_YEAR_START Or y > LUNAR_YEAR_END Then Err.Raise Number:=6, DESCRIPTION:="只接受 " & LUNAR_YEAR_START & " - " & LUNAR_YEAR_END & " 之间的公历日期" Exit Function End If lunarYearFirstDay = dateOfLunarYearBegin(y - LUNAR_YEAR_START) If lunarYearFirstDay > dt Then result.year = y - 1 lunarYearFirstDay = dateOfLunarYearBegin(result.year - LUNAR_YEAR_START) Else result.year = y End If result.day = DateDiff("d", lunarYearFirstDay, dt) + 1 leapMonth = GetLeapMonth(result.year) mask = &H8000& For i = 1 To 12 ' 正常月份 daysOfMonth = GetLunarMonthDays(result.year, mask) If result.day > daysOfMonth Then result.day = result.day - daysOfMonth Else result.month = i Exit For End If ' 闰月 If leapMonth = i Then daysOfMonth = GetLeapDays(result.year) If result.day > daysOfMonth Then result.day = result.day - daysOfMonth Else result.month = i result.isLeap = True Exit For End If End If mask = mask / 2 Next i ' 二十四节气 n = (DatePart("m", dt) - 1) * 2 gregorianDay = DatePart("d", dt) If gregorianDay > 15 Then n = n + 2 Else n = n + 1 End If If GetSolarTerm(y, n) = gregorianDay Then result.solarIndex = n Else result.solarIndex = 0 End If GetLunar = resultEnd Function'#### 类初始化，数据准备Private Sub Class_Initialize() Dim i As Integer, itemCount As Integer, sum As Long compressLunarInfo = 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 - 1 sum = 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 Long Dim i As Integer, mask As Long, sum As Long, leapMonth As Integer If m < 1 Then GetMultiLunarMonthDays = 0 Exit Function End If mask = &H8000& sum = 0 i = 1 ' 各正常月份天数累加 While (i <= m) And (mask > &H8) sum = sum + GetLunarMonthDays(y, mask) mask = mask / 2 i = i + 1 Wend ' 闰月天数累加 leapMonth = GetLeapMonth(y) If leapMonth > 0 And leapMonth < m Then sum = sum + GetLeapDays(y) End If GetMultiLunarMonthDays = sumEnd Function'#### 返回 y 年指定月份的天数Private Function GetLunarMonthDays(y As Long, ByVal mask As Long) As Long If (compressLunarInfo(y - LUNAR_YEAR_START) And mask) = mask Then GetLunarMonthDays = 30 Else GetLunarMonthDays = 29 End IfEnd Function'#### 返回 y 年闰月的天数Private Function GetLeapDays(y As Long) As Long If (compressLunarInfo(y - LUNAR_YEAR_START + 1) And &HF) = &HF Then GetLeapDays = 30 Else GetLeapDays = 29 End IfEnd Function'#### 返回 y 年闰月的月份，1-12，没闰传回 0Private Function GetLeapMonth(y As Long) As Long Dim leapMonth As Long leapMonth = (compressLunarInfo(y - LUNAR_YEAR_START) And &HF) If leapMonth = &HF Then GetLeapMonth = 0 Else GetLeapMonth = leapMonth End IfEnd Function
当遗忘变成另一种开始，淡了回忆，痛最真实…
