（相信到這步大家應(yīng)該會了．）
第五步：根據(jù)天干數(shù)，地支數(shù)，確定天干，地支
=INDEX(數(shù)據(jù)表!B2:B11,L1)
=INDEX(數(shù)據(jù)表!D2:D13,參數(shù)表!L2)
回顧一下：我們查出了年干支數(shù)，月干支數(shù)，日干支數(shù)．
其中，我們需要提供的僅僅是公歷的年月日，陰歷的月份．
陽歷的年月日可以自動從系統(tǒng)提取，但是陰歷的月份日期怎么來呢？我們不知道??？
我們可以自定義一個函數(shù)：
ＡＬＴ+Ｆ11，打開＂Ｖisual Basic＂編輯器，新建模塊，復(fù)制下面的代碼：
'公歷轉(zhuǎn)農(nóng)歷模塊'原創(chuàng)：互聯(lián)網(wǎng)'修正：犟神 2005/1/12'// 農(nóng)歷數(shù)據(jù)定義 //'先以 H2B 函數(shù)還原成長度為 18 的字符串，其定義如下：'前12個字節(jié)代表1-12月：1為大月，0為小月；壓縮成十六進(jìn)制(1-3位)'第13位為閏月的情況，1為大月30天，0為小月29天；(4位)'第14位為閏月的月份，如果不是閏月為0，否則給出月份(5位)'最后4位為當(dāng)年農(nóng)歷新年的公歷日期，如0131代表1月31日；當(dāng)作數(shù)值轉(zhuǎn)十六進(jìn)制(6-7位)'農(nóng)歷常量(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 = "鼠牛虎兔龍蛇馬羊猴雞狗豬"'公歷日期轉(zhuǎn)農(nóng)歷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年內(nèi)的農(nóng)歷數(shù)據(jù) 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) '農(nóng)歷新年日期 getDay = DateDiff("d", conDate, setDate) + 1 '相差天數(shù) 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 '計(jì)算天數(shù) 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 = "農(nóng)歷" & YLyear & "(" & YLShuXing & ")年" & mm0 & dd0aErr: End Function'農(nóng)歷轉(zhuǎn)公歷日期'secondMonth 為真，則天示當(dāng) 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))) '農(nóng)歷新年日期 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)) '十六進(jìn)制轉(zhuǎn)二進(jìn)制 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) '十六進(jìn)制轉(zhuǎn)十進(jìn)制 H2B = H2B & "0" & CStr(Val("&H" & Right(strHex, 2)))End Function
保存模塊，返回表格，我們使用用戶自定義函數(shù)，獲得陰歷：
（注：上述自定義函數(shù)只能計(jì)算1899-2100年日期）
R17=GetYLDate(today())
先發(fā)現(xiàn)月字在提取的日期中的位置：
R18=FIND("月",R17)
R19=MID(R17,R18-1,2)
將右圖對應(yīng)表格的十一月改為冬月，十二月改為臘月．
好了．．．．沒啥講的了．
順便說一句，這些公式算起來，只是大概不會錯．
但實(shí)際上，干支計(jì)算還有諸多因素要考慮進(jìn)去，所以有些結(jié)果，你會和老黃歷對應(yīng)不上，在此，我們不過是為了練習(xí)幾個函數(shù)的用法罷了，不當(dāng)之處，還請一笑了之．．．
