黑丝 av VBA农历转公历
发布日期：2025-04-20 07:17 点击次数：182
农历是阴阳合历，每年有12个月，大月30天，小月29天，若是有闰月，闰月也分大小月，亦然30天或29天。一年有24骨气黑丝 av，骨气以太阳运转轨迹为准，基本原则是每月两个骨气，永别在月首3号阁下，月尾24号阁下。闰月频繁设置在只消一个骨气的月份之后。农历新年，所以24骨气的立春为界，立春后动手新的一年。
编程计算：编程源代码原型：http://s.o4u.com/host/blog/calendar/calendar.htm Sean Lin (林洵賢)
以一个整数数组来保存各农积年的12个月大小月情况，以及闰月月份，闰月大小月，通过查表格式，谋略农历日历。
例：1900年的数据为 &H4BD8，用二进制示意：
图片黑丝 av
以字为单元。
前12个bit，次序示意1-12月份的大小月，1为大月30天，0为小月29天
ai换脸 刘亦菲后4bit分为两种情况：
1、闰月的月份（如1000，二进制转为十进制为8，示意该年闰八月）
2、前一年闰月的大小月标记（二进制0000示意闰小月，二进制1111示意闰大月）
闰月大小月与当昨年份不在一皆，而是鄙人一年的数据中，但不会产生毁坏，是因为相邻两年，不行能同为闰月年。
编程念念路：
取给定农历与岁首正月月吉的天数，再在岁首公历日历的基础上，加上出入的天数，得到新的公历日历即可；若是要由公历得到农历，则反一下即可。
VBA类代码：''字据农积年月日取对应公历日历 类模块' (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 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 GetDateFromLunar(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 GetDateFromLunar = DateAdd("d"， sum， dateOfLunarYearBegin(y - LUNAR_YEAR_START))End 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 iEnd 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图片
-完-黑丝 av
本站仅提供存储劳动，统统本色均由用户发布，如发现存害或侵权本色，请点击举报。