Excel+VBA製作萬年曆(一):計算方法

Excel做的小遊戲各種被贊,然而那些都是抖機靈的小作品。目前做過兩個比較讓我頭疼的功能,一個是之前發過的數獨,另一個是萬年曆,這次給大家分享的就是萬年曆。網上有各種各樣的萬年曆插件,JS、C#或其他語言的演算法,這裡綜合了一下「翻譯」成VBA展示出來。

萬年曆基本的功能包括:陽曆、陰曆、節氣、節假日、傳統節日、黃曆等,陽曆的顯示用Excel自帶函數就能完成,和陰曆的對應則需要相應的演算法。包含這麼多信息量的一個萬年曆,我們用類模塊來實現。

一、單日類模塊

我們先新建一個類模塊,命名為calElement,把需要的信息都做成這個類模塊的成員。

Option Explicitn單日類模塊nnPublic sYear As Integer 陽曆年nPublic sMonth As Integer 陽曆月nPublic sDay As Integer 陽曆日nPublic week As String 星期nnPublic lYear As Integer 陰曆年nPublic lMonth As Integer 陰曆月nPublic lDay As Integer 陰曆日:nPublic isLeap As Boolean 是否閏nnPublic cYear As String 年柱nPublic cMonth As String 月柱nPublic cDay As String 天柱nnPublic cMnumber As Integer 月份編號nPublic cDnumber As Double 日期編號nnPublic color As String 顏色nPublic isToday As Boolean 是否今天nPublic lunarFestival As String 陰曆節日nPublic solarFestival As String 陽曆節日nPublic solarTerms As String 節氣nnnPublic Sub Init(sYear As Integer, sMonth As Integer, sDay As Integer, week As String, lYear As Integer, lMonth As Integer, lDay As Integer, isLeap As Boolean, cYear As String, cMonth As String, cDay As String, cMnum As Integer, cDnum As Double)nnMe.isToday = Falsenn陽曆nMe.sYear = sYearnMe.sMonth = sMonthnMe.sDay = sDaynMe.week = weeknn農曆nMe.lYear = lYearnMe.lMonth = lMonthnMe.lDay = lDaynMe.isLeap = isLeapnn八字nMe.cYear = cYearnMe.cMonth = cMonthnMe.cDay = cDaynnMe.cMnumber = cMnumnMe.cDnumber = cDnumnnMe.color = ""nIf week = "日" Or week = "六" Then Me.color = "red"nMe.lunarFestival = ""nMe.solarFestival = ""nMe.solarTerms = ""nnEnd Subn

解釋一下,這裡的年柱、月柱、天柱是八字的內容,和月份、日期編號一起用來計算宜忌的,具體演算法後面會說明。作為日曆的最小元素天,以上內容基本包含了我們所有想要的信息。

二、月曆類模塊

萬年曆一般是以月份的形式呈現,我們需要一個月曆的類,將剛才的單日類以及一些月份信息裝進去。

Option Explicitn月曆類模塊nnPublic length As IntegernPublic firstWeek As IntegernPublic calElement As Variantnn常量數組nPublic Gan As Variant 天干nPublic Zhi As Variant 地支nPublic Animals As Variant 生肖nPublic solarTerm As Variant 節氣nPublic sTermInfo As Variant 節氣計算編碼nPublic nStr1 As Variant 陰曆日期個位nPublic nStr2 As Variant 陰曆日期十位nPublic MonthName As Variant 英文月份名nPublic cmonthName As Variant 陰曆月份名nPublic sFtv As Variant 陽曆節日 *表示放假日nPublic wFtv As Variant 月周節日nPublic lFtv As Variant 陰曆節日nnPublic Sub Class_Initialize()n初始化常量數組nnGan = Array("甲", "乙", "丙", "丁", "戊", "己", "庚", "辛", "壬", "癸")nZhi = Array("子", "丑", "寅", "卯", "辰", "巳", "午", "未", "申", "酉", "戌", "亥")nAnimals = Array("鼠", "牛", "虎", "兔", "龍", "蛇", "馬", "羊", "猴", "雞", "狗", "豬")nsolarTerm = Array("小寒", "大寒", _n "立春", "雨水", "驚蟄", "春分", "清明", "穀雨", _n "立夏", "小滿", "芒種", "夏至", "小暑", "大暑", _n "立秋", "處暑", "白露", "秋分", "寒露", "霜降", _n "立冬", "小雪", "大雪", "冬至")nsTermInfo = Array(0, 21208, 42467, 63836, 85337, 107014, 128867, 150921, 173149, 195551, 218072, 240693, 263343, 285989, 308563, 331033, 353350, 375494, 397447, 419210, 440795, 462224, 483532, 504758)nnStr1 = Array("日", "一", "二", "三", "四", "五", "六", "七", "八", "九", "十")nnStr2 = Array("初", "十", "廿", "卅", "□")nMonthName = Array("JAN", "FEB", "MAR", "APR", "MAY", "JUN", "JUL", "AUG", "SEP", "OCT", "NOV", "DEC")ncmonthName = Array("正", "二", "三", "四", "五", "六", "七", "八", "九", "十", "十一", "臘")nsFtv = Array( _n"0101*元旦", _n"0214 情人節", _n"0308 婦女節", _n"0312 植樹節", _n"0401 愚人節", _n"0422 地球日", _n"0501*勞動節", _n"0504 青年節", _n"0531 無煙日", _n"0601 兒童節", _n"0606 愛眼日", _n"0701 建黨日", _n"0707 抗戰紀念日", _n"0801 建軍節", _n"0910 教師節", _n"0918 九·一八事變紀念日", _n"1001*國慶節", _n"1031 萬聖節", _n"1111 光棍節", _n"1201 艾滋病日", _n"1213 南京大屠殺紀念日", _n"1224 平安夜", _n"1225 聖誕節")nn某月的第幾個星期幾。 5,6,7,8 表示到數第 1,2,3,4 個星期幾n例,母親節為,5月第二個星期日nwFtv = Array( _n"0520 母親節", _n"0630 父親節", _n"1144 感恩節")nnlFtv = Array( _n"0101*春節", _n"0115 元宵節", _n"0202 龍抬頭", _n"0505*端午節", _n"0707 七夕", _n"0715 中元節", _n"0815*中秋節", _n"0909 重陽節", _n"1208 臘八節", _n"1223 小年", _n"0100*除夕")nnEnd Subn

本來想隨便列一下,結果常量數組多到令人髮指。其中需要解釋有幾個:節氣計算編碼,通過演算法計算1900年後的節氣時間;陽曆節日、陰曆節日,還有以某月的某周幾來計算的特殊節日,都用類似區間碼的形式存放在數組裡。

1、初始化年月

VBA類模塊的Class_Initialize是系統默認的初始化方法,但是這個方法不能傳入參數,我們還需要手動初始化一下。通過讀取年、月的信息,將這一個月的信息計算出來。因為內容較多,接下來會一段一段展示。

Public Sub Init(ByVal y As Integer, ByVal m As Integer)nnDim sDObj, lDObj, lY%, lM%, lD%, lL As Boolean, lX, tmp1, tmp2, tmp3, i%nlD = 1nlX = 0nDim cY$, cM$, cD$ 年柱,月柱,日柱nDim cDnum As Double, cMnum%nDim lDPOS(2) As IntegernDim n, firstLMnn = 0nfirstLM = 0nnsDObj = toDate(y, m, 1)nlength = solarDay(y, m) 陽曆當月天數nfirstWeek = Weekday(sDObj) - 1 陽曆當月1日星期幾nn年柱 1900年立春後為庚子年(60進位36)nIf m < 2 Thenn cY = cyclical(y - 1900 + 36 - 1)nElsen cY = cyclical(y - 1900 + 36)nEnd Ifnn立春日期nDim term2nterm2 = sTerm(y, 2)nnm = m - 1 月份計算修正n月柱 1900年1月小寒以前為 丙子月(60進位12)nDim firstNodenfirstNode = sTerm(y, m * 2)ncMnum = (y - 1900) * 12 + m + 11ncM = cyclical(cMnum)nn當月一日與 1900/1/1 相差天數n1900/1/1與 1970/1/1 相差25567日, 1900/1/1 日柱為甲戌日(60進位10)nDim dayCyclical As DoublendayCyclical = CLng(time2unix(sDObj) / 86400 + 25567 + 10)n

我們先根據年月,返回出了當月1日的日期格式。這裡是自己寫的toDate函數,我把它寫在了一個叫公共方法的模塊里。

Public Function toDate(ByVal y As Integer, ByVal m As Integer, ByVal d As Integer, Optional ByVal hh As Integer = 0, Optional ByVal mm As Integer = 0, Optional ByVal ss As Integer = 0) As DatentoDate = CDate(y & "-" & m & "-" & d & " " & hh & ":" & mm & ":" & ss)nEnd Functionn

然後返回了陽曆天數和星期,Weekday是自帶函數,solarDay實現如下:

Public Function solarDay(ByVal y As Integer, ByVal m As Integer) As Integern返回陽曆 y年某m+1月的天數nDim d As Date, nextMonth As Datend = toDate(y, m, 1)nnextMonth = DateAdd("m", 1, d)nsolarDay = DateDiff("d", d, nextMonth)nnEnd Functionn

接下來計算年柱,年月日柱都是把一個60進位的數字轉換成干支,函數如下:

Public Function cyclical(ByVal num As Long) As Stringn傳入 offset 返回干支, 0=甲子nDim m%, n%nm = num Mod 10nn = num Mod 12ncyclical = Gan(m) & Zhi(n)nnEnd Functionn

接著,計算了當年第一個節氣「立春」的日子,用了sTerm函數:

Public Function sTerm(ByVal y As Integer, ByVal n As Integer) As Integern某年的第n個節氣為幾日(從0小寒起算)nDim offdate As DatenDim unixTime As Long, tempUnix As DoublentempUnix = time2unix("1900-01-06 10:05:00") * 1000nunixTime = CLng((31556925974.7 * (y - 1900) + sTermInfo(n) * 60000 + tempUnix) / 1000)noffdate = unix2time(unixTime)nsTerm = DatePart("d", offdate)nnEnd Functionn

然後計算了當月第一個個節氣的日期firstNode,以及當月的黃曆計數cMnum,最後返回的月柱,也就是干支計數cM。然後用unix時間戳計算出了當月1日的與1900年1月1日相差的天數,其中時間與unix時間戳互換的函數如下:

Public Function time2unix(ByVal dateday As Date) As Doublentime2unix = DateDiff("s", "1970-01-01 08:00:00", dateday)nEnd FunctionnnPublic Function unix2time(ByVal unixTime As Long) As Datenunix2time = DateAdd("s", unixTime, "1970-01-01 08:00:00")nEnd Functionn

2、初始化日

接下來我們需要把Me.calElement作為一個長度為Me.length的數組,把每天的信息放入。VBA無法直接在公共成員定義數組,我們只能利用臨時數組變數存儲信息,再給它賦值。

Dim tmpCal() As calElementnReDim tmpCal(1 To Me.length)nFor i = 1 To Me.lengthn n If lD > lX Then 陰曆日大於陰曆月天數n sDObj = toDate(y, m + 1, i)n Set lDObj = New lunarn lDObj.Init (sDObj)n lY = lDObj.yearn lM = lDObj.monthn lD = lDObj.dayn lL = lDObj.isLeapn If lL Thenn lX = lDObj.leapDays(lY)n Elsen lX = lDObj.monthDays(lY, lM)n End Ifn n If n = 0 Then firstLM = lMn n = n + 1n lDPOS(n - 1) = i - lD - 1n End Ifn n 依節氣調整二月分的年柱, 以立春為界n If m = 1 And i = term2 Then cY = cyclical(y - 1900 + 36)n 依節氣月柱, 以「節」為界n If i = firstNode Then cM = cyclical((y - 1900) * 12 + m + 13)n 日柱n cDnum = dayCyclical + i - 1n If i >= firstNode Then cMnum = (y - 1900) * 12 + m + 13n cD = cyclical(cDnum)n n Dim w$n w = nStr1((i + Me.firstWeek - 1) Mod 7)nn Set tmpCal(i) = New calElementn n Call tmpCal(i).Init(y, m + 1, i, w, lY, lM, lD, lL, cY, cM, cD, cMnum, cDnum)nn lD = lD + 1nnNext inMe.calElement = tmpCaln

這個循環從陽曆當月1日到最後一天,當陰曆日大於陰曆天數的時候,說明陰曆月增加了,需要重新計算,其他時候都按陰曆日+1計算。當日期為2月的立春日時,從新調整年柱;當日期為當月第一個節氣時調整月柱;計算日柱;返回星期;創建新的calElement類,把計算結果的信息都放進去,日期+1進行下一次循環。

計算陰曆時,有一個很重要的lunar類,我們在第三塊內容中再詳細介紹,先說明循環之後的一些關於節氣和節假日的計算。

3、初始化節氣、節假日

節氣需要先用sTerm計算出日期,再將calElement數組中該日對應的solarTerms成員賦值為solarTerm數組的內容即可。

節氣ntmp1 = sTerm(y, m * 2) - 1ntmp2 = sTerm(y, m * 2 + 1) - 1nMe.calElement(tmp1 + 1).solarTerms = solarTerm(m * 2)nMe.calElement(tmp2 + 1).solarTerms = solarTerm(m * 2 + 1)n

節假日需要分別對陽曆節日、陰曆節日、月周節日的數組進行遍歷,將對應日期的節假日賦值到calElement數組的成員中。

Dim arrFtv As VariantnDim jn陽曆節日nFor Each j In sFtvn arrFtv = match(j, "(d{2})(d{2})([s*])(.+)")n If CInt(arrFtv(1)) = m + 1 Thenn Me.calElement(CInt(arrFtv(2))).solarFestival = arrFtv(4)n If arrFtv(3) = "*" Then Me.calElement(CInt(arrFtv(2))).color = "red"n End IfnNextnn陰曆節日nFor Each j In lFtvn arrFtv = match(j, "(d{2})(.{2})([s*])(.+)")n tmp1 = CInt(arrFtv(1)) - firstLMn If tmp1 = -11 Then tmp1 = 1n If tmp1 >= 0 And tmp1 < n Thenn tmp2 = lDPOS(tmp1) + CInt(arrFtv(2))n If tmp2 >= 0 And tmp2 < Me.length Thenn If Me.calElement(tmp2 + 1).isLeap = False Thenn Me.calElement(tmp2 + 1).lunarFestival = arrFtv(4)n If arrFtv(3) = "*" Then Me.calElement(tmp2 + 1).color = "red"n End Ifn End Ifn End IfnNextnn月周節日nFor Each j In wFtvn arrFtv = match(j, "(d{2})(d)(d)([s*])(.+)")n If CInt(arrFtv(1)) = m + 1 Thenn tmp1 = CInt(arrFtv(2))n tmp2 = CInt(arrFtv(3))n Dim X%: X = 0n If tmp1 < 5 Thenn If Me.firstWeek > tmp2 Then X = 7n Me.calElement(X + 7 * (tmp1 - 1) + tmp2 - Me.firstWeek + 1).solarFestival = arrFtv(5)n Elsen tmp1 = tmp1 - 5n tmp3 = (Me.firstWeek + Me.length - 1) Mod 7 當月最後一天星期?n If tmp2 > tmp3 Then X = 7n Me.calElement(Me.length - tmp3 - 7 * tmp1 + tmp2 - X).solarFestival = arrFtv(5)n End Ifn End IfnNextnnEnd Subn

節假日的處理方法都相似,先將數組內容通過match函數拆分成數組,再找到對應的當月節日。match函數用到了正則匹配的方法,代碼如下:

Public Function match(ByVal sText As String, ByVal RegExp As String) As Variantnn Dim n%, arrStr, i%n n = UBound(Split(RegExp, ")"))n ReDim arrStr(1 To n)n n Dim oRegExp As Object 定義正則表達式對象n Dim oMatches As Object 定義匹配字元串集合對象n Set oRegExp = CreateObject("vbscript.regexp") 創建正則表達式n With oRegExpn .Global = True 設置是否匹配所有的符合項,True表示匹配所有, False表示僅匹配第一個符合項n .IgnoreCase = True 設置是否區分大小寫,True表示不區分大小寫, False表示區分大小寫n .Pattern = RegExp 設置要查找的字元模式n MsgBox .test(sText) 判斷是否可以找到匹配的字元,若可以則返回Truen Set oMatches = .Execute(sText) 對字元串執行正則查找,返回所有的查找值的集合,若未找到,則為空n match = .Replace(sText, "$1,$2,$3,$4") 把字元串中用正則找到的所有匹配字元替換為其它字元n For i = 1 To nn arrStr(i) = .Replace(sText, "$" & i)n Next in End Withn Set oRegExp = Nothingn Set oMatches = Nothingn match = arrStrn nEnd Functionn

三、陰曆類模塊

新建一個類模塊命名為lunar,計算陰曆的年月日以及是否閏月等信息。

1、初始化

Option Explicitn陰曆計算nnPublic year As IntegernPublic month As IntegernPublic day As IntegernPublic isLeap As Booleannn常量數組nPublic lunarInfo As VariantnnPrivate Sub Class_Initialize()n初始化常量數組nnlunarInfo = Array( _n&H4BD8, &H4AE0, &HA570, &H54D5, &HD260, &HD950, &H5554, &H56AF, &H9AD0, &H55D2, _n&H4AE0, &HA5B6, &HA4D0, &HD250, &HD295, &HB54F, &HD6A0, &HADA2, &H95B0, &H4977, _n&H497F, &HA4B0, &HB4B5, &H6A50, &H6D40, &HAB54, &H2B6F, &H9570, &H52F2, &H4970, _n&H6566, &HD4A0, &HEA50, &H6A95, &H5ADF, &H2B60, &H86E3, &H92EF, &HC8D7, &HC95F, _n&HD4A0, &HD8A6, &HB55F, &H56A0, &HA5B4, &H25DF, &H92D0, &HD2B2, &HA950, &HB557, _n&H6CA0, &HB550, &H5355, &H4DAF, &HA5B0, &H4573, &H52BF, &HA9A8, &HE950, &H6AA0, _n&HAEA6, &HAB50, &H4B60, &HAAE4, &HA570, &H5260, &HF263, &HD950, &H5B57, &H56A0, _n&H96D0, &H4DD5, &H4AD0, &HA4D0, &HD4D4, &HD250, &HD558, &HB540, &HB6A0, &H95A6, _n&H95BF, &H49B0, &HA974, &HA4B0, &HB27A, &H6A50, &H6D40, &HAF46, &HAB60, &H9570, _n&H4AF5, &H4970, &H64B0, &H74A3, &HEA50, &H6B58, &H5AC0, &HAB60, &H96D5, &H92E0, _n&HC960, &HD954, &HD4A0, &HDA50, &H7552, &H56A0, &HABB7, &H25D0, &H92D0, &HCAB5, _n&HA950, &HB4A0, &HBAA4, &HAD50, &H55D9, &H4BA0, &HA5B0, &H5176, &H52BF, &HA930, _n&H7954, &H6AA0, &HAD50, &H5B52, &H4B60, &HA6E6, &HA4E0, &HD260, &HEA65, &HD530, _n&H5AA0, &H76A3, &H96D0, &H4AFB, &H4AD0, &HA4D0, &HD0B6, &HD25F, &HD520, &HDD45, _n&HB5A0, &H56D0, &H55B2, &H49B0, &HA577, &HA4B0, &HAA50, &HB255, &H6D2F, &HADA0, _n&H4B63, &H937F, &H49F8, &H4970, &H64B0, &H68A6, &HEA5F, &H6B20, &HA6C4, &HAAEF, _n&H92E0, &HD2E3, &HC960, &HD557, &HD4A0, &HDA50, &H5D55, &H56A0, &HA6D0, &H55D4, _n&H52D0, &HA9B8, &HA950, &HB4A0, &HB6A6, &HAD50, &H55A0, &HABA4, &HA5B0, &H52B0, _n&HB273, &H6930, &H7337, &H6AA0, &HAD50, &H4B55, &H4B6F, &HA570, &H54E4, &HD260, _n&HE968, &HD520, &HDAA0, &H6AA6, &H56DF, &H4AE0, &HA9D4, &HA4D0, &HD150, &HF252, _n&HD520)nnEnd Subn

這個lunarInfo是根據紫金天文台計算出來的1900年後200年陰曆信息,把大小月和閏月信息用2進位表示再轉換成16進位的結果。雖然陰曆類模塊只有4個成員,但是計算起來十分麻煩。

Public Sub Init(ByVal objDate As Date)nnDim i, leap, temp, offsetnleap = 0ntemp = 0nnoffset = (time2unix(objDate) - time2unix(toDate(1900, 1, 30))) / 86400nnFor i = 1900 To 2099n If offset < 0 Then Exit Forn temp = lYearDays(i)n offset = offset - tempnNext innIf offset < 0 Then offset = offset + temp: i = i - 1nnMe.year = innleap = leapMonth(i)nMe.isLeap = FalsennFor i = 1 To 12n If offset < 0 Then Exit Forn n 閏月n If leap > 0 And i = leap + 1 And Me.isLeap = False Thenn i = i - 1n Me.isLeap = Truen temp = leapDays(Me.year)n Elsen temp = monthDays(Me.year, i)n End Ifn n 解除閏月n If Me.isLeap = True And i = leap + 1 Then Me.isLeap = Falsen offset = offset - tempnNext innIf offset = 0 And leap > 0 And i = leap + 1 Thenn If Me.isLeap Thenn Me.isLeap = Falsen Elsen Me.isLeap = Truen i = i - 1n End IfnEnd IfnnIf offset < 0 Then offset = offset + temp: i = i - 1nnMe.month = inMe.day = offsetnnEnd Subn

計算陰曆的方法很笨,先計算傳入的陽曆時間月歷史時間戳天數差值offset,再根據每個陰曆年的天數去減少這個差值,直到差值小於0。再把年數倒退一年,將日期的差值加回來。計算閏月的方法類似,用剩餘的差值不停減每個月的天數,通過小於0的差值計算出陰曆月。再倒退一個月,把差值加回正數,剩下的差值就是陰曆天。

2、函數方法

初始化方法中用了很多計算函數,接下來一一說明。

計算陰曆年時,用到的陰曆年天數函數:

Public Function lYearDays(ByVal y As Integer) As Integern返回陰曆 y年的總天數nDim i, sumnsum = 348nni = Hex2Bin("8000")nDo While (Len(i) > 4)n Dim hexbooln hexbool = "&H" & Hex(lunarInfo(y - 1900)) And "&H" & Hex(Bin2Dec(i))n If hexbool <> 0 Then sum = sum + 1n i = Left(i, Len(i) - 1)nLoopnlYearDays = sum + leapDays(y)nnEnd Functionn

用到了16進位的AND(按位與)計算,以及16、10、2進位的互相轉換。VBA自帶10進位轉16進位的函數Hex,其他的都需要自己寫。

Public Function Hex2Dec(ByVal h As String) As Longn16進位轉10進位nSelect Case hn Case "A"n Hex2Dec = 10n Case "B"n Hex2Dec = 11n Case "C"n Hex2Dec = 12n Case "D"n Hex2Dec = 13n Case "E"n Hex2Dec = 14n Case "F"n Hex2Dec = 15n Case Elsen Hex2Dec = CInt(h)nEnd SelectnEnd FunctionnnPublic Function Dec2Bin(ByVal d As Long) As Stringn10進位轉2進位,4位nDec2Bin = ""nDo While d > 0n Dec2Bin = d Mod 2 & Dec2Binn d = Int(d / 2)nLoopnDo While Len(Dec2Bin) < 4nDec2Bin = "0" & Dec2BinnLoopnnEnd FunctionnnPublic Function Bin2Dec(ByVal b As String) As Longn2進位轉10進位nBin2Dec = 0nDim inFor i = 1 To Len(b)n Bin2Dec = Bin2Dec + 2 ^ (Len(b) - i) * CInt(Mid(b, i, 1))nNext inEnd FunctionnnPublic Function Hex2Bin(ByVal h As String) As Stringn16進位轉2進位nHex2Bin = ""nDim inDim bin(15) As StringnFor i = 0 To 15n bin(i) = Dec2Bin(i)nNext innFor i = 1 To Len(h)n Hex2Bin = Hex2Bin & bin(Hex2Dec(Mid(h, i, 1)))nNext inEnd FunctionnnPublic Function Bin2Dec(ByVal b As String) As Longn2進位轉10進位nBin2Dec = 0nDim inFor i = 1 To Len(b)n Bin2Dec = Bin2Dec + 2 ^ (Len(b) - i) * CInt(Mid(b, i, 1))nNext inEnd Functionn

計算陰曆月時先返回了閏月:

Public Function leapMonth(ByVal y As Integer) As Integern返回陰曆 y年閏哪個月 1-12 , 沒閏返回 0nDim lMnlM = "&H" & Hex(lunarInfo(y - 1900)) And "&HF"nIf lM = &HF Thenn leapMonth = 0nElsen leapMonth = lMnEnd IfnEnd Functionn

然後用到了該年的閏月天數:

Public Function leapDays(ByVal y As Integer) As Integern返回陰曆 y年閏月的天數nIf leapMonth(y) Thenn Dim hexbooln hexbool = "&H" & Hex(lunarInfo(y - 1899)) And "&HF"n If hexbool = &HF Thenn leapDays = 30n Elsen leapDays = 29n End IfnElsen leapDays = 0nEnd IfnEnd Functionn

還有該年某月的天數:

Public Function monthDays(ByVal y As Integer, ByVal m As Integer) As Integern返回陰曆 y年m月的總天數nDim hexboolnhexbool = "&H" & Hex(lunarInfo(y - 1900)) And "&H" & Bin2Hex(binDisplacement(Hex2Bin("10000"), m))nIf hexbool Thenn monthDays = 30nElsen monthDays = 29nEnd IfnnEnd Functionn

這些方法在月曆模塊中,初始化日時也有用到。

四、黃曆信息類模塊

黃曆信息,就是在選擇某日後,萬年曆右邊顯示的信息。新建一個info的類模塊,初始化如下:

Option Explicitn黃曆信息模塊nnPublic lunar As String 陰曆信息nPublic y_info As String 陰曆年nPublic m_info As String 陰曆月nPublic huangliY As String 黃曆宜nPublic huangliJ As String 黃曆忌nnnPublic Sub Init(ByVal cld_day As calElement)nnDim leap$nleap = ""nIf cld_day.isLeap Then leap = "閏"nnDim calnSet cal = New calendarnMe.lunar = "農曆" & leap & cal.cMonth(cld_day.lMonth) & "月" & cal.cDay(cld_day.lDay)nMe.y_info = cld_day.cYear & "年【" + cal.lunar_year(cld_day.lYear) + "】 "nMe.m_info = cld_day.cMonth & "月" + cld_day.cDay & "日"nnDim cM, cD, month, jianxing, jiazi, huangliY, huangliJncM = cld_day.cMnumberncD = cld_day.cDnumbernnmonth = (cM - 2) Mod 12njianxing = (cD - month) Mod 12njiazi = cD Mod 60nnIf Len(jianxing) = 1 Then jianxing = "0" & jianxingnIf Len(jiazi) = 1 Then jiazi = "0" & jiazinnDim YJArraynSet YJArray = New lunarJsonnYJArray.getLunar (jianxing & jiazi)nMe.huangliY = YJArray.ynMe.huangliJ = YJArray.jnnEnd Subn

將一個calElement對象傳入,通過對象中的陰曆年月日返回基本信息,通過之前設置的月份編號、日期編號計算「建星」與「甲子」的編號,再根據這個編號從一個已有的表中去獲取宜與忌的信息。

我們把黃曆宜忌的JSON信息存儲在「黃曆」Sheet中,通過lunarJson這個類去獲取。

Option Explicitn黃曆JSON處理nnPublic y As StringnPublic j As StringnnnPublic Sub getLunar(ByVal index As String)nnWith Worksheets("黃曆")nDim rowIndex%nrowIndex = .Cells.Find(what:=index).RownnMe.y = Mid(Trim(.Cells(rowIndex + 1, 1).value), 6, Len(Trim(.Cells(rowIndex + 1, 1).value)) - 7)nMe.j = Mid(Trim(.Cells(rowIndex + 2, 1).value), 6, Len(Trim(.Cells(rowIndex + 2, 1).value)) - 6)nnEnd WithnnEnd Subn

所有後端計算的內容,我們都已經通過類模塊實現了。前端展現的內容,下一篇文章中再說。

稍微學習了下怎麼使用GitHub,原諒我的英語並不知道這能做些什麼……

github.com/huangchen103


推薦閱讀:

Excel+VBA製作數獨(二):類模塊篇
Excel+VBA圖靈完備:Rule 110

TAG:Excel编程 | VBA | 万年历 |