日曆干支換算（年月日）

日曆干支換算（年月日）  

2014-04-04 18:57:52|  分類： 一技之長 |  標籤：干支經年演算法  |舉報|字型大小 訂閱

 先補充點小知識：古時以干支表示時辰，一天合12個時辰，1個時辰相當於現在的2小時。子 23～1  丑 1～3 寅 3～5 卯 5～7 辰 7～9 巳  9～1  午 11～13  未 13～15  申 15～17  酉 17～19  戌 19～21  亥 21～23
我們知道，農村人忌諱，無論幹什麼事，先看老黃曆。陰曆彷彿真是趨吉避凶的參照。
那麼陰曆的很多數據是怎麼算來的呢？先說年干。大家知道，今年是馬年，又說甲午年。
年干支演算法：①推算天干：公元年末位數-3=年干(適用於任何年代)。②推算地支：公元年末二位數+9=年支(適用於十九世紀，即1800—1899 年)； 公元年末二位數十1=年支(適用於二十世紀，即1900—1999 年)；  公元年末二位數+5=年支(適用於廿一世紀，即2000—2099 年)；  說明： ①年干按1(甲).2(乙)、3(丙)、4(丁)、5(戊)、6(己)、7(庚)、8(辛)、9(壬)、10(癸)順序；  年支按1(子)、2(丑)、3(寅)、4(卯)、5(辰)、6(巳)、7(午)、8(未)、9(申)、10(酉)、11(戌)、12(亥)順序。  ②求年干，不夠減則借10；求年支，超過12要遞減12，取餘數。  ③求年干之公式，適用於任何年代；求年支之公式，不同公式只適用於某一世紀「00年)。 
我們打開EXCEL,根據上面的條件，列出公式：

 系統時間如果無誤，我們分別填入公式：k1=today()提取當前系統日期j2=year(k1)提取k1的年份數l2=month(k1)提取k1的月份數n2=day(k1)提取k1的日期數
年干演算法：年的末尾k4=--RIGHT(J2,1)--表示把序數由文本轉換為數字天干數m4=IF(IF(K4>2,K4-3,K4+7)=0,10,IF(K4>2,K4-3,K4+7))天干o4=INDEX(B3:B12,MATCH(K5,C3:C12),1,1)
年支演算法：

 年的末尾兩位數k4=--RIGHT(J2,2)應加數m5=IF(J2>2099,"不知道",IF(J2>=2000,5,IF(J2>=1900,1,IF(J2>=1800,9,"不知道"))))地支數p5=MOD(K5+M5,12)地支=INDEX(E3:E14,MATCH(P5,F3:F14),1,1)
月干演算法：

甲已之年丙作首，乙庚之歲戊為頭， 丙辛之歲尋庚上，丁壬壬寅順行流，戊癸之年何方發，甲寅之上好追求。
月支順序是固定的：寅卯辰巳午未申酉戌亥子丑對應正月二月三月四月五月六月七月八月九月十月十一月十二月
在ＥＸＣＥＬ中，先作源表：如右圖．上面我們已經求過年的天幹了，直接拿來就用．所以有：設Q12為年干，L4為月份:

 年干位置：K7=MATCH(Q12,B21:B31,0)月份位置：K6=MATCH(L4,B21:N21,0)所以月干支為：=INDEX(B21:N31,K7,K6)

日干支演算法

根據公曆日期計算當日干支口訣，經過校正後，應為：
　　乘5除4,9加日，　　雙月間隔30天。　　一二自加整少1，　　0三四1,六2, 七，
　　3,4,5八十尾順。計算基本公式是：（××年×5＋××年÷4＋9＋日＋修正值）÷60＝商……餘數日干確定：取餘數的個位為天干序數，對應天干（餘數為0，對應天干是癸）。日支確定：餘數÷12＝商……［餘數］，取［餘數］為地支序數，對應地支（［餘數］為0，對應地支為亥）(逢閏年 一二月不加,平年加1,加2)  一月加修正值1,二月加修正值2,三月不加修正值，四、五月加1,六、七月加2，八月加3，九、十月加4，十一、十二月加5。具體怎麼算呢？ 
 如右圖：設b2為年份，b4 為日期，b5為年末尾兩位數第一步：確定被判斷年份是否大於2000，

先判斷是否閏年．b9=IF(MOD(B2,4)<>0,"",IF(MOD(B2,100)<>0,"閏年",IF(MOD(B2,400)<>0,"","閏年")))根據判斷，確定修正月格式b10=B9&B3根據修正月，查詢是修正值b11=INDEX(數據表!AC4:AC27,MATCH(B10,數據表!AA4:AA27,0))第二步：判斷是否雙月，並確定附加值b8=IF(MOD(B3,2)=0,30,0)第三步：判斷是否大於等於2000，並確認附加值b6=IF(B2>=2000,100,0)第三步：確認日天干數：m1=MOD((B6+B5)*5+QUOTIENT((B5+B6),4) +9+B4+B11+B8,60)L1=--RIGHT(M1,1)第四步：確認日地支數：I2=IF(MOD(M1,12)=0,10,MOD(M1,12))

（相信到這步大家應該會了．）第五步：根據天干數，地支數，確定天干，地支=INDEX(數據表!B2:B11,L1)=INDEX(數據表!D2:D13,參數表!L2)
回顧一下：我們查出了年干支數，月干支數，日干支數．其中，我們需要提供的僅僅是公曆的年月日，陰曆的月份．陽曆的年月日可以自動從系統提取，但是陰曆的月份日期怎麼來呢？我們不知道啊？我們可以自定義一個函數：ＡＬＴ+Ｆ11，打開＂Ｖisual Basic＂編輯器，新建模塊，複製下面的代碼：
"公曆轉農曆模塊"原創：互聯網"修正：犟神 2005/1/12"// 農曆數據定義 //"先以 H2B 函數還原成長度為 18 的字元串，其定義如下："前12個位元組代表1-12月：1為大月，0為小月；壓縮成十六進位(1-3位)"第13位為閏月的情況，1為大月30天，0為小月29天；(4位)"第14位為閏月的月份，如果不是閏月為0，否則給出月份(5位)"最後4位為當年農曆新年的公曆日期，如0131代表1月31日；當作數值轉十六進位(6-7位)"農曆常量(1899~2100，共202年）Private Const ylData = "AB500D2,4BD0883," _ & "4AE00DB,A5700D0,54D0581,D2600D8,D9500CC,655147D,56A00D5,9AD00CA,55D027A,4AE00D2," _ & "A5B0682,A4D00DA,D2500CE,D25157E,B5500D6,56A00CC,ADA027B,95B00D3,49717C9,49B00DC," _ & "A4B00D0,B4B0580,6A500D8,6D400CD,AB5147C,2B600D5,95700CA,52F027B,49700D2,6560682," _ & "D4A00D9,EA500CE,6A9157E,5AD00D6,2B600CC,86E137C,92E00D3,C8D1783,C9500DB,D4A00D0," _ & "D8A167F,B5500D7,56A00CD,A5B147D,25D00D5,92D00CA,D2B027A,A9500D2,B550781,6CA00D9," _ & "B5500CE,535157F,4DA00D6,A5B00CB,457037C,52B00D4,A9A0883,E9500DA,6AA00D0,AEA0680," _ & "AB500D7,4B600CD,AAE047D,A5700D5,52600CA,F260379,D9500D1,5B50782,56A00D9,96D00CE," _ & "4DD057F,4AD00D7,A4D00CB,D4D047B,D2500D3,D550883,B5400DA,B6A00CF,95A1680,95B00D8," _ & "49B00CD,A97047D,A4B00D5,B270ACA,6A500DC,6D400D1,AF40681,AB600D9,93700CE,4AF057F," _ & "49700D7,64B00CC,74A037B,EA500D2,6B50883,5AC00DB,AB600CF,96D0580,92E00D8,C9600CD," _ & "D95047C,D4A00D4,DA500C9,755027A,56A00D1,ABB0781,25D00DA,92D00CF,CAB057E,A9500D6," _ & "B4A00CB,BAA047B,B5500D2,55D0983,4BA00DB,A5B00D0,5171680,52B00D8,A9300CD,795047D," _ & "6AA00D4,AD500C9,5B5027A,4B600D2,96E0681,A4E00D9,D2600CE,EA6057E,D5300D5,5AA00CB," _ & "76A037B,96D00D3,4AB0B83,4AD00DB,A4D00D0,D0B1680,D2500D7,D5200CC,DD4057C,B5A00D4," _ & "56D00C9,55B027A,49B00D2,A570782,A4B00D9,AA500CE,B25157E,6D200D6,ADA00CA,4B6137B," _ & "93700D3,49F08C9,49700DB,64B00D0,68A1680,EA500D7,6AA00CC,A6C147C,AAE00D4,92E00CA," _ & "D2E0379,C9600D1,D550781,D4A00D9,DA400CD,5D5057E,56A00D6,A6C00CB,55D047B,52D00D3," _ & "A9B0883,A9500DB,B4A00CF,B6A067F,AD500D7,55A00CD,ABA047C,A5A00D4,52B00CA,B27037A," _ & "69300D1,7330781,6AA00D9,AD500CE,4B5157E,4B600D6,A5700CB,54E047C,D1600D2,E960882," _ & "D5200DA,DAA00CF,6AA167F,56D00D7,4AE00CD,A9D047D,A2D00D4,D1500C9,F250279,D5200D1"Private Const ylMd0 = "初一初二初三初四初五初六初七初八初九初十十一十二十三十四十五" _ & "十六十七十八十九二十廿一廿二廿三廿四廿五廿六廿七廿八廿九三十 "Private Const ylMn0 = "正二三四五六七八九十冬臘"Private Const ylTianGan0 = "甲乙丙丁戊己庚辛壬癸"Private Const ylDiZhi0 = "子丑寅卯辰巳午未申酉戌亥"Private Const ylShu0 = "鼠牛虎兔龍蛇馬羊猴雞狗豬""公曆日期轉農曆Function GetYLDate(ByVal strDate As String) As StringOn Error GoTo aErr If Not IsDate(strDate) Then Exit Function Dim setDate As Date, tYear As Integer, tMonth As Integer, tDay As Integer setDate = CDate(strDate) tYear = Year(setDate): tMonth = Month(setDate): tDay = Day(setDate) "如果不是有效有日期，退出 If tYear > 2100 Or tYear < 1900 Then Exit Function Dim daList() As String * 18, conDate As Date, thisMonths As String Dim AddYear As Integer, AddMonth As Integer, AddDay As Integer, getDay As Integer Dim YLyear As String, YLShuXing As String Dim dd0 As String, mm0 As String, ganzhi(0 To 59) As String * 2 Dim RunYue As Boolean, RunYue1 As Integer, mDays As Integer, i As Integer "載入2年內的農曆數據 ReDim daList(tYear - 1 To tYear) daList(tYear - 1) = H2B(Mid(ylData, (tYear - 1900) * 8 + 1, 7)) daList(tYear) = H2B(Mid(ylData, (tYear - 1900 + 1) * 8 + 1, 7)) AddYear = tYearinitYL: 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 "相差天數 If getDay < 1 Then AddYear = AddYear - 1: GoTo initYL thisMonths = Left(daList(AddYear), 14) RunYue1 = Val("&H" & Right(thisMonths, 1)) "閏月月份 If RunYue1 > 0 Then "有閏月 thisMonths = Left(thisMonths, RunYue1) & Mid(thisMonths, 13, 1) & Mid(thisMonths, RunYue1 + 1) End If thisMonths = Left(thisMonths, 13) For i = 1 To 13 "計算天數 mDays = 29 + CInt(Mid(thisMonths, i, 1)) If getDay > mDays Then getDay = getDay - mDays Else If RunYue1 > 0 Then If i = RunYue1 + 1 Then RunYue = True If i > RunYue1 Then i = i - 1 End If AddMonth = i AddDay = getDay Exit For End If Next dd0 = Mid(ylMd0, (AddDay - 1) * 2 + 1, 2) mm0 = Mid(ylMn0, AddMonth, 1) + "月" For i = 0 To 59 ganzhi(i) = Mid(ylTianGan0, (i Mod 10) + 1, 1) + Mid(ylDiZhi0, (i Mod 12) + 1, 1) Next i YLyear = ganzhi((AddYear - 4) Mod 60) YLShuXing = Mid(ylShu0, ((AddYear - 4) Mod 12) + 1, 1) If RunYue Then mm0 = "閏" & mm0 GetYLDate = "農曆" & YLyear & "(" & YLShuXing & ")年" & mm0 & dd0aErr: End Function"農曆轉公曆日期"secondMonth 為真，則天示當 tMonth 是閏月時，取第二個月Function GetDate(ByVal tYear As Integer, tMonth As Integer, tDay As Integer, Optional secondMonth As Boolean = False) As StringOn Error GoTo aErr If tYear > 2100 Or tYear < 1899 Or tMonth > 12 Or tMonth < 1 Or tDay > 30 Or tDay < 1 Then Exit Function Dim thisMonths As String, ylNewYear As Date, toMonth As Integer Dim mDays As Integer, RunYue1 As Integer, i As Integer thisMonths = H2B(Mid(ylData, (tYear - 1899) * 8 + 1, 7)) If tDay > 29 + CInt(Mid(thisMonths, tMonth, 1)) Then Exit Function ylNewYear = DateSerial(tYear, CInt(Mid(thisMonths, 15, 2)), CInt(Mid(thisMonths, 17, 2))) "農曆新年日期 thisMonths = Left(thisMonths, 14) RunYue1 = Val("&H" & Right(thisMonths, 1)) "閏月月份 toMonth = tMonth - 1 If RunYue1 > 0 Then "有閏月 thisMonths = Left(thisMonths, RunYue1) & Mid(thisMonths, 13, 1) & Mid(thisMonths, RunYue1 + 1) If tMonth > RunYue1 Or (secondMonth And tMonth = RunYue1) Then toMonth = tMonth End If thisMonths = Left(thisMonths, 13) mDays = 0 For i = 1 To toMonth mDays = mDays + 29 + CInt(Mid(thisMonths, i, 1)) Next mDays = mDays + tDay GetDate = ylNewYear + mDays - 1aErr: End Function"將壓縮的陰曆字元還原Private Function H2B(ByVal strHex As String) As String Dim i As Integer, i1 As Integer, tmpV As String Const hStr = "0123456789ABCDEF" Const bStr = "0000000100100011010001010110011110001001101010111100110111101111" tmpV = UCase(Left(strHex, 3)) "十六進位轉二進位 For i = 1 To Len(tmpV) i1 = InStr(hStr, Mid(tmpV, i, 1)) H2B = H2B & Mid(bStr, (i1 - 1) * 4 + 1, 4) Next H2B = H2B & Mid(strHex, 4, 2) "十六進位轉十進位 H2B = H2B & "0" & CStr(Val("&H" & Right(strHex, 2)))End Function

保存模塊，返回表格，我們使用用戶自定義函數，獲得陰曆：（註：上述自定義函數只能計算1899-2100年日期）R17=GetYLDate(today())先發現月字在提取的日期中的位置：R18=FIND("月",R17)R19=MID(R17,R18-1,2)將右圖對應表格的十一月改為冬月，十二月改為臘月．
好了．．．．沒啥講的了．順便說一句，這些公式算起來，只是大概不會錯．但實際上，干支計算還有諸多因素要考慮進去，所以有些結果，你會和老黃曆對應不上，在此，我們不過是為了練習幾個函數的用法罷了，不當之處，還請一笑了之．．．