VB的农历算法

日历实现vb代码Dim tian, di As StringDim cyear, cmonth, cday As Integer Dim year1, month1, day1 As Integer Dim n, k, i, j As IntegerDim total As LongDim date1, date2 As DateDim IsendAs BooleanDim st As StringDim data(100) As StringDim yueDim temp As IntegerPrivate Sub Combo2_click()year1 = Val(Combo2.Text)month1 = Val(Combo1.Text)day1 = 1Isend = Falsek = 0n = 0x = cal()Label2.Caption = disp2()Label3.Caption = f()Label4.Caption = redisp()End SubPrivate Sub Combo1_click()year1 = Val(Combo2.Text)month1 = Val(Combo1.Text)day1 = 1Isend = Falsek = 0n = 0x = cal()Picture1.ClsPicture1.Print redisp()Label2.Caption = disp2()End SubPrivate Sub Form_Initialize()'以字符串形式统计农历信息，data(0) = "101001001011" data(1) = "51011001001011" data(2) = "011010100101" data(3) = "011011010100" data(4) = "41010110110101" data(5) = "001010110110" data(6) = "100101010111" data(7) = "20100100101111" data(8) = "010*********" data(9) = "60110010010110" data(10) = "110101001010" data(11) = "111010100101" data(12) = "50110110101001" data(13) = "010*********" data(14) = "001010110110" data(15) = "31001001101110" data(16) = "100100101110" data(17) = "71100100101101" data(18) = "110010010101" data(19) = "110101001010" data(20) = "61101101001010" data(21) = "101101010101" data(22) = "010*********" data(23) = "41010101011011" data(24) = "001001011101" data(25) = "100100101101" data(26) = "21100100101011" data(27) = "101010010101" data(28) = "71011010010101" data(29) = "011011001010" data(30) = "101101010101" data(31) = "50101010110101" data(32) = "010*********" data(33) = "101001011011" data(34) = "30101001010111" data(35) = "010*********" data(36) = "81010100101010" data(37) = "111010010101" data(38) = "011010101010" data(39) = "61010110101010"data(41) = "010*********" data(42) = "41010010101110" data(43) = "101001010111" data(44) = "010*********" data(45) ="31110100100110" data(46) = "110110010101" data(47) = "70101101010101" data(48) = "010*********" data(49) = "100101101101" data(50) = "50100101011101" data(51) = "010*********" data(52) = "101001001101" data(53) = "41101001001101" data(54) = "110100100101" data(55) = "81101010100101" data(56) = "101101010100" data(57) = "101101101010" data(58) = "61001011011010" data(59) = "100101011011" data(60) = "010*********" data(61) = "41010010010111" data(62) = "101001001011" data(63) = "A1011001001011" data(64) = "011010100101" data(65) = "011011010100" data(66) = "61010110110100" data(67) = "101010110110" data(68) = "100101010111" data(69) = "50100100101111" data(70) = "010*********" data(71) = "011001001011" data(72) = "30110101001010" data(73) = "111010100101" data(74) = "80110101100101" data(75) = "010*********" data(76) = "101010110110" data(77) = "51001001101101" data(78) = "100100101110" data(79) = "110010010110" data(80) = "41101010010101" data(81) = "110101001010" data(82) = "110110100101" data(83) = "20101101010101"data(85) = "71010101011011"data(86) = "001001011101"data(87) = "100100101101"data(88) = "51100100101011"data(89) = "101010010101"data(90) = "101101001010"data(91) = "41011010101010"data(92) = "101011010101"data(93) = "90101010110101"data(94) = "010*********"data(95) = "101001011011"data(96) = "60101001010111"data(97) = "010*********"data(98) = "101010010011"data(99) = "40111010010101"year1 = Year(Now)month1 = Month(Now)day1 = Day(Now)x = calLabel1.Caption = disp3()End SubPrivate Sub Form_Load()For j = 0 To 11Combo1.List(j) = j + 1Next jFor i = 0 To 99Combo2.List(i) = i + 1921Next iCombo1.T ext = Combo1.List(Month(Now) - 1) Combo2.Text = Combo2.List(Year(Now) - 1921) tian = "甲乙丙丁戊己庚辛壬癸"di = "子丑寅卯辰巳午未申酉戌亥"Isend = Falsek = 0n = 0year1 = Year(Now)month1 = Month(Now)day1 = 1x = calLabel2.Caption = disp2() '天干地支纪年Form1.ShowPicture1.Print redisp() '显示农历阳历在图片框上Label5.Caption = Year(Now) & "年" & Month(Now) & "月" & Day(Now) & "日"End SubFunction disp1() As String '以汉字形式显示农历信息ri1 = "初一初二初三初四初五初六初七初八初九初十十一十二十三十四十五十六十七十八十九廿十廿一廿二廿三廿四廿五廿六廿七廿八廿九三十"yue = Array("一", "二", "三", "四", "五", "六", "七", "八", "九", "十", "冬", "腊")st = ""st = st + Mid(ri1, 2 * cday - 1, 2)If cday = 1 ThenIf cmonth< 0 Thenst = "闰" &yue(-cmonth - 1)Elsest = yue(cmonth - 1) & "月"End IfEnd Ifdisp1 = stEnd FunctionFunction disp2() As String '天干地支纪年法Dim tmp As Stringtmp = ""tmp = Mid(tian, ((Year(Now) - 4) Mod 10) + 1, 1) + Mid(di, ((Year(Now) - 4) Mod 12) + 1, 1) & "年" disp2 = tmpEnd FunctionFunction disp3() As String '把农历信息以汉字的形式输出ri1 = "初一初二初三初四初五初六初七初八初九初十十一十二十三十四十五十六十七十八十九廿十廿一廿二廿三廿四廿五廿六廿七廿八廿九三十"yue = Array("一", "二", "三", "四", "五", "六", "七", "八", "九", "十", "冬", "腊")If cmonth< 0 Thenst = "闰" &yue(-cmonth - 1) & "月"Elsest = yue(cmonth - 1) & "月"End Ifst = st + Mid(ri1, 2 * cday - 1, 2)disp3 = stEnd FunctionFunction cal() As String '以1921年2月8日为基准点，计算阳历某一天对应的阴历k = 0: n = 0: total = 0date1 = DateSerial(year1, month1, day1)date2 = #2/8/1921#total = DateDiff("d", date2, date1) + 1Dot = data(k)n = IIf(Len(t) = 14, 2, 1)i = (2 * (n - 1) + 13)DoIf total <= 29 + Val(Mid(t, n, 1)) ThenIsend = TrueExit DoEnd Iftotal = total - 29 - Val(Mid(t, n, 1))n = n + 1temp = nIf (n = i) ThenEnd IfLoopIf (Isend = True) ThenExit DoEnd Ifk = k + 1Loopcyear = 1921 + kcmonth = ncday = totalIf Len(data(k)) = 14 ThenIf (cmonth>Val(Mid(data(k), 1, 1)) + 2) Thencmonth = cmonth - 2ElseIf cmonth = Val(Mid(data(k), 1, 1)) + 2 Thencmonth = 2 - cmonthElsecmonth = cmonth - 1End IfEnd IfEnd IfEnd FunctionFunction redisp() As String '把阳历和农历放到一块以字符串的形式的组合到一起redisp = " 日" + "一" + "二" + "三" + "四" + "五" + "六" + Chr(13) + Chr(13)date1 = DateSerial(year1, month1, day1)s = Weekday(date1)Dim a As IntegerFor i = 1 To s - 1redisp = redisp + Space(7)NextFor i = 1 To days(month1)Call addredisp = redisp + " " + Format(i, "!@@@@@") If a Mod 7 = 0 Andi< 8 Thenredisp = redisp + Chr(13)For j = 1 To s - 1redisp = redisp + Space(7)NextFor b = s To 7redisp = redisp + disp1() + " "cday = cday + 1Call addNext bredisp = redisp + Chr(13) + Chr(13)ElseIf (a Mod 7 = 0 Andi>= 8) Thenredisp = redisp + Chr(13)For j = i - 6 Toiredisp = redisp + disp1() + " "cday = cday + 1Call addNext jredisp = redisp + Chr(13) + Chr(13)End IfIf i = days(month1) And a <> 0 Thenredisp = redisp + Chr(13)For j = 1 To aredisp = redisp + disp1() + " "cday = cday + 1Call addNext jEnd Ifa = (a + 1) Mod 7NextEnd FunctionFunction days(month1) As Integer '判断阳历每个月的天数Select Case month1Case 1, 3, 5, 7, 8, 10, 12days = 31Case 4, 6, 9, 11days = 30Case 2If (year1 Mod 4 = 0 And year1 Mod 100 <> 0) Or (year1 Mod 400 = 0) Thendays = 29Elsedays = 28End IfEnd SelectEnd FunctionPrivate Sub Timer1_Timer() '调用系统时间，显示时分秒Label6.Caption = Format(Hour(Time) & ":" & Minute(Time) & ":" & Second(Time), "hh:mm:ss") End SubSub add() '农历的日期加一天之后的农历If Len(data(cyear - 1921)) = 12 ThenIf cday> 29 + Val(Mid(data(cyear - 1921), cmonth, 1)) Then cday = 1: cmonth = cmonth + 1If cmonth = 13 Then cmonth = 1: cyear = cyear + 1 End IfElseIfLen(data(cyear - 1921)) = 14 ThenSelect Case cmonthCase Is < 0If cday> 29 + Val(Mid(data(cyear - 1921), -cmonth + 2, 1)) Then cday = 1: cmonth = -cmonth + 1End IfCase Is <="" 1,="" 1921),="" bdsfid="281" p="">If cday> 29 + Val(Mid(data(cyear - 1921), cmonth + 1, 1)) Then cday = 1: cmonth = cmonth + 1End IfCase Is = V al(Mid(data(cyear - 1921), 1, 1))If cday> 29 + Val(Mid(data(cyear - 1921), cmonth + 1, 1)) Then cday = 1: cmonth = -cmonthEnd IfCase Is >Val(Mid(data(cyear - 1921), 1, 1))If cday> 29 + Val(Mid(data(cyear - 1921), cmonth + 2, 1)) Then cday = 1: cmonth = cmonth + 1End IfEnd SelectEnd IfEnd Sub。

vb日历程序设计VB日历程序设计介绍在计算机程序设计中，日历程序是一种常见的应用程序。

使用日历程序，用户可以查看特定年份和月份的日期，并可以添加、编辑和删除事件。

本文将介绍如何使用Visual Basic（VB）来设计和实现一个简单的日历程序。

准备工作在开始编写日历程序之前，确保你已经安装了Visual Basic开发环境，并且具备一定的VB编程基础。

如果你对VB还不熟悉，可以参考一些VB编程入门教程来提升自己的编程技能。

主要功能我们的日历程序将具备以下主要功能：1. 显示当前年份和月份2. 显示当前月份的日期3. 允许用户切换到上一个月、下一个月4. 允许用户添加、编辑和删除事件5. 允许用户查看特定日期的事件列表编码实现获取当前年份和月份在VB中，我们可以使用`DateAndTime.Now.Year`和`DateAndTime.Now.Month`来获取当前的年份和月份。

可以创建一个标签控件来显示这些数据：```vbLabel1.Text = DateAndTime.Now.Year.ToString()Label2.Text = DateAndTime.Now.Month.ToString()```显示当前月份的日期我们可以使用一个表格控件（DataGridView）来显示当前月份的日期。

可以按照以下步骤来实现：1. 在窗体上添加一个表格控件并命名为`DataGridView1`。

2. 设置表格控件的列数为7，表示一周有七天。

3. 设置表格控件的行数为6，表示一个月最多有六周。

4. 使用循环语句将日期填充到表格控件的单元格中。

以下是实现上述步骤的示例代码：```vbDim currentMonth As Integer = DateAndTime.Now.MonthDim currentYear As Integer = DateAndTime.Now.YearDim daysInMonth As Integer =Date.DaysInMonth(currentYear, currentMonth)Dim firstDayOfMonth As New Date(currentYear, currentMonth, 1)Dim startColumn As Integer = firstDayOfMonth.DayOfWeek Dim currentDay As Integer = 1For row As Integer = 0 To 5For col As Integer = 0 To 6DataGridView1.Rows(row).Cells(col).Value = currentDaycurrentDay += 1If currentDay > daysInMonth ThenExit ForEnd IfNextNext```切换月份我们可以使用两个按钮控件来实现切换到上一个月和下一个月的功能。

函数nlgl获取月日，nly获取年份。

这是本人在用的函数，也是借鉴网上已有的函数，但网上其它版本基本都有个问题：计算有闰月的农历的时候，会不准确，下面的从1970到2011年的均经过一一对比，没有问题。

根据阳历日期获得农历，是没问题的，但如果根据农历算阳历，就不好办了：辛卯年冬月廿七是阳历哪天？答：2011-01-01，对也不对，农历按天干地支算，每60年就会重复的；下面参数'IsGetGl为true表示根据农历返回阳历，根据农历返回阳历则valdate必须是阳历的年份加农历的月日,如2010-01-01（2010年的正月初一）对应的阳历是2011-02-03'******************************阳历、农历转换Function nlgl(valdate As Date, Optional IsShort As Boolean, Optional IsGetGl As Boolean) Dim tYear As IntegerDim tMonth As IntegerDim tDay As IntegerDim i As IntegertYear = Year(valdate)tMonth = Month(valdate)tDay = Day(valdate)On Error Resume NextDim daList(1900 To 2100) As String * 18Dim conDate As Date, setDate As DateDim AddMonth As Integer, AddDay As Integer, AddYear As Integer, getDay As IntegerDim RunYue As BooleanIf tYear > 2100 Or tYear < 1900 Then GoTo yyyy:If tYear < 1900 ThentYear = tYear + 19 * Int((1942 - tYear) / 19)ElseIf tYear > 2100 ThentYear = tYear - 19 * Int((tYear - 1942) / 19)End IfEnd If '如IF THE VALDATE NOT IN CASE,THEN TRANSITION THEN VALDATE'1900 to 2100' 前12个字节代表农历的1-12月为大月或是小月，1为大月30天，0为小月29天，' ' '第13位为闰月的情况，1为大月30天，0为小月29天，第14位为闰月的月'' '份，如果不是闰月为0，否则给出月份，10、11、12分别用A、B、C来表'' '示，即使用16进制。

Type LunarInfoiLorSMonth(13) As Integer '定义阴历大小月标志数组iTotalDays As Integer '定义春节开始的天数iLeapMonth As Integer '定义闰月的月份bLeapYear As Boolean '定义闰年标志End TypeType LunarDatestrChinseEra As String * 4 '阴历年的干支strLunarMonthName As String * 8 '阴历月份名称strLunarDayName As String * 4 '阴历日子名称strLunarAnimal As String * 2 '阴历年份属相iLunarDay As Integer '阴历日子数值iLunarMonth As Integer '阴历月份数值，如果是闰月，则返回负值End TypePublic strHeavenlyStems(10) As String '定义天干数组Public strEarthlyBranches(12) As String '定义地支数组Public strAnimal(12) As String '定义属相数组Public strZodiac As String '定义星座变量Public strLunarMonthName(12) As String '定义阴历月份名称数组Public strLunarDayName(30) As String '定义阴历日子名称数组Public lLunarData(1900 To 2100) As Long '定义阴历信息数组Public strSolarTerms(24) As String '定义二十四节气名称数组Public dSolarTermsInfo(24) As Double '定义二十四节气信息数组Public thisLunarInfo As LunarInfo '定义阴历信息记录体Public thisLunardate As LunarDate '定义阴历日期记录体'***************************************************************'* 获取阴历年开始天数*'***************************************************************Public Function GetLunarBeginDays(ByVal iYear As Integer) As IntegerDim strbinLunarInfo As StringstrbinLunarInfo = SetLunarBinStr(iYear)If Len(strbinLunarInfo) > 19 ThenGetLunarBeginDays = Bin2Int(Mid(strbinLunarInfo, Len(strbinLunarInfo) - 18, 6)) ElseGetLunarBeginDays = Bin2Int(Mid(strbinLunarInfo, 1, Len(strbinLunarInfo) - 13)) End IfEnd Function'*************************************************************** '* 获取阴历年日子数值子程序* '***************************************************************Public Function GetLunarNumDay(ByVal strDate As String) As Integer Call Solar2Lunar(strDate)GetLunarNumDay = thisLunardate.iLunarDayEnd Function'*************************************************************** '* 获取阴历年月份数值子程序* '***************************************************************Public Function GetLunarNumMonth(ByVal strDate As String) As Integer Call Solar2Lunar(strDate)GetLunarNumMonth = thisLunardate.iLunarMonthEnd Function'*************************************************************** '* 获取阴历年属相子程序* '***************************************************************Public Function GetLunarAnimal(ByVal strDate As String) As String Call Solar2Lunar(strDate)GetLunarAnimal = thisLunardate.strLunarAnimalEnd Function'*************************************************************** '* 获取阴历年信息子程序* '***************************************************************Public Function GetLunarYear(ByVal strDate As String) As String Call Solar2Lunar(strDate)GetLunarYear = thisLunardate.strChinseEraEnd Function'*************************************************************** '* 获取阴历月信息子程序* '***************************************************************Public Function GetLunarMonth(ByVal strDate As String) As StringCall Solar2Lunar(strDate)GetLunarMonth = thisLunardate.strLunarMonthNameEnd Function'***************************************************************'* 获取阴历日信息子程序*'***************************************************************Public Function GetLunarDay(ByVal strDate As String) As StringCall Solar2Lunar(strDate)GetLunarDay = thisLunardate.strLunarDayNameEnd Function'***************************************************************'* 设置阴历信息子程序*'***************************************************************Public Sub SetLunarInfo(iYear As Integer)Dim strbinLunarInfo As StringDim strFirstDay As StringDim iTotalDays As IntegerDim strLSMonth As StringDim tmpi As IntegerstrbinLunarInfo = SetLunarBinStr(iYear)If Len(strbinLunarInfo) > 19 ThenthisLunarInfo.bLeapYear = TruethisLunarInfo.iTotalDays = Bin2Int(Mid(strbinLunarInfo, Len(strbinLunarInfo) - 18, 6))thisLunarInfo.iLeapMonth = Bin2Int(Mid(strbinLunarInfo, 1, Len(strbinLunarInfo) - 19)) ElsethisLunarInfo.bLeapYear = FalsethisLunarInfo.iTotalDays = Bin2Int(Mid(strbinLunarInfo, 1, Len(strbinLunarInfo) - 13))thisLunarInfo.iLeapMonth = 0End IfstrLSMonth = Right(strbinLunarInfo, 13)For tmpi = 0 To 12thisLunarInfo.iLorSMonth(tmpi) = Val(Mid(strLSMonth, tmpi + 1, 1)) Next tmpiPublic Function SetLunarBinStr(iYear As Integer) As StringSetLunarBinStr = Dec2Bin(lLunarData(iYear))End Function'***************************************************************'* 阳历转换阴历子程序*'***************************************************************Public Sub Solar2Lunar(strDate As String)Dim tmpyear As IntegerDim strbinLunarInfo As StringDim strFirstDay As StringDim iTotalDays As Integertmpyear = Year(DateV alue(strDate))Call SetLunarInfo(tmpyear)strFirstDay = tmpyear & "-1-1"iTotalDays = DateV alue(strDate) - DateValue(strFirstDay)If iTotalDays < thisLunarInfo.iTotalDays Then tmpyear = tmpyear - 1Call SetLunarInfo(tmpyear)strFirstDay = tmpyear & "-1-1"iTotalDays = DateV alue(strDate) - DateValue(strFirstDay)thisLunardate.strChinseEra = strHeavenlyStems((tmpyear - 4) Mod 10) & strEarthlyBranches((tmpyear - 4) Mod 12)thisLunardate.strLunarAnimal = strAnimal((tmpyear - 4) Mod 12)Dim itmp As IntegerDim itmpLunarDays As IntegerDim iMonthDays As Integeritmp = 0itmpLunarDays = iTotalDays - thisLunarInfo.iTotalDaysIf thisLunarInfo.iLorSMonth(itmp) = 1 Then iMonthDays = 29 Else iMonthDays = 28Do While itmpLunarDays > iMonthDaysIf thisLunarInfo.iLorSMonth(itmp) = 1 ThenitmpLunarDays = itmpLunarDays - 30itmp = itmp + 1End IfElseIf itmpLunarDays >= 29 ThenitmpLunarDays = itmpLunarDays - 29itmp = itmp + 1End IfEnd IfIf thisLunarInfo.iLorSMonth(itmp) = 1 Then iMonthDays = 29 Else iMonthDays = 28 LoopIf thisLunarInfo.bLeapYear ThenIf itmp < thisLunarInfo.iLeapMonth ThenthisLunardate.strLunarMonthName = strLunarMonthName(itmp)thisLunardate.strLunarDayName = strLunarDayName(itmpLunarDays)thisLunardate.iLunarMonth = itmp + 1thisLunardate.iLunarDay = itmpLunarDays + 1ElseIf itmp = thisLunarInfo.iLeapMonth ThenthisLunardate.strLunarMonthName = "闰" & strLunarMonthName(itmp - 1)thisLunardate.strLunarDayName = strLunarDayName(itmpLunarDays)thisLunardate.iLunarMonth = -itmpthisLunardate.iLunarDay = -(itmpLunarDays + 1)ElsethisLunardate.strLunarMonthName = strLunarMonthName(itmp - 1)thisLunardate.strLunarDayName = strLunarDayName(itmpLunarDays)thisLunardate.iLunarMonth = itmpthisLunardate.iLunarDay = itmpLunarDays + 1End IfElsethisLunardate.strLunarMonthName = strLunarMonthName(itmp)thisLunardate.strLunarDayName = strLunarDayName(itmpLunarDays)thisLunardate.iLunarMonth = itmp + 1thisLunardate.iLunarDay = itmpLunarDays + 1End IfEnd Sub'***************************************************************'* 获取节气的名称*'* 输入参数：strDate 表示要判断节气的日期*'* 返回值是：节气字符串，如果该日期不是节气，则返回空值*'***************************************************************Public Function GetSolarTermName(ByVal strDate As String) As StringIf strDate = GetSolarTermDate(Year(DateV alue(strDate)), (Month(Date) - 1) * 2) ThenGetSolarTermName = strSolarTerms((Month(Date) - 1) * 2)End IfIf strDate = GetSolarTermDate(Year(DateV alue(strDate)), (Month(Date) - 1) * 2 + 1) Then GetSolarTermName = strSolarTerms((Month(Date) - 1) * 2 + 1)End IfEnd Function'***************************************************************'* 获取节气的日期*'* 输入参数：iDateYear 表示年*'* 输入参数：iSolarTerm 表示第几个节气*'* 返回值是日期字符串*'* 0-小寒1-大寒2-立春3-雨水4-惊蛰5-春分*'* 6-清明7-谷雨8-立夏9-小满10-芒种11-夏至*'* 12-小暑13-大暑14-立秋15-处暑16-白露17-秋分*'* 18-寒露19-霜降20-立冬21-小雪22-大雪23-冬至*'***************************************************************Public Function GetSolarTermDate(ByVal iDateYear As Integer, ByVal iSolarTerm As Integer) As StringGetSolarTermDate = DateValue("1900-1-6") + Int((31556925974.7 * (iDateYear - 1900) + (dSolarTermsInfo(iSolarTerm) * 60000) + 2# * 60 * 60 * 1000 + 5# * 60 * 1000) / 86400000)End Function'***************************************************************'* 获取星座名称*'* 输入参数是日期字符串*'* 返回值是字符串*'***************************************************************Public Function GetZodiacName(ByVal strDate As String) As StringDim iMonthDay As IntegerDim strZodiacName As StringiMonthDay = Month(DateValue(strDate)) * 100 + Day(DateValue(strDate))Select Case iMonthDayCase Is < 120Case Is < 219strZodiacName = "水瓶座（Aquarius）"Case Is < 321strZodiacName = "双鱼座（Pisces）"Case Is < 421strZodiacName = "白羊（牡羊）座（Aries）"Case Is < 521strZodiacName = "金牛座（Taurus）"Case Is < 622strZodiacName = "双子座（Gemini）"Case Is < 723strZodiacName = "巨蟹座（Cancer）"Case Is < 823strZodiacName = "狮子座（Leo）"Case Is < 923strZodiacName = "处女座（Virgo）"Case Is < 1023strZodiacName = "天秤座（Libra）"Case Is < 1122strZodiacName = "天蝎座（Scorpio）"Case Is < 1222strZodiacName = "人马（射手）座（Sagittarius）"Case ElsestrZodiacName = "山羊（摩羯）座（Capricorn）"End SelectGetZodiacName = strZodiacNameEnd Function'*************************************************************** '* 转换十进制长整型数成二进制字符串* '* 输入参数lDecNumber * '* 返回值是字符串* '***************************************************************Public Function Dec2Bin(ByVal lDecNumber As Long) As StringDim strBin As StringIf lDecNumber < 0 ThenExit FunctionElseDo While lDecNumber > 0strBin = (lDecNumber Mod 2) & strBinlDecNumber = lDecNumber \ 2End IfDec2Bin = strBinEnd Function'************************************************************** '* 转换二进制数字符串成十进制整型数* '* 输入参数是一个二进制数的字符串* '* 返回值是一个整型的数值* '**************************************************************Public Function Bin2Int(ByVal strBin As String) As IntegerDim rtiDec As IntegerDim tmpi As IntegerrtiDec = 0For tmpi = 1 To Len(strBin)' If (Mid(strBin, tmpi, 1) = "1") Then' rtiDec = rtiDec * 2 + 1' Else' rtiDec = rtiDec * 2' End IfrtiDec = rtiDec * 2 + Val(Mid(strBin, tmpi, 1))NextBin2Int = rtiDecEnd Function'************************************************************** '* 信息数组初始化* '**************************************************************Public Sub InitInfoArray()'************************************************************** '* 天干数组赋值* '**************************************************************strHeavenlyStems(0) = "甲"strHeavenlyStems(1) = "乙"strHeavenlyStems(2) = "丙"strHeavenlyStems(3) = "丁"strHeavenlyStems(4) = "戊"strHeavenlyStems(6) = "庚"strHeavenlyStems(7) = "辛"strHeavenlyStems(8) = "壬"strHeavenlyStems(9) = "癸"'**************************************************************'* 地支数组赋值* '**************************************************************strEarthlyBranches(0) = "子"strEarthlyBranches(1) = "丑"strEarthlyBranches(2) = "寅"strEarthlyBranches(3) = "卯"strEarthlyBranches(4) = "辰"strEarthlyBranches(5) = "巳"strEarthlyBranches(6) = "午"strEarthlyBranches(7) = "未"strEarthlyBranches(8) = "申"strEarthlyBranches(9) = "酉"strEarthlyBranches(10) = "戌"strEarthlyBranches(11) = "亥"'*************************************************************** '* 属相数组赋值* '***************************************************************strAnimal(0) = "鼠"strAnimal(1) = "牛"strAnimal(2) = "虎"strAnimal(3) = "兔"strAnimal(4) = "龙"strAnimal(5) = "蛇"strAnimal(6) = "马"strAnimal(7) = "羊"strAnimal(8) = "猴"strAnimal(9) = "鸡"strAnimal(10) = "狗"strAnimal(11) = "猪"'*************************************************************** '* 阴历月份名称数组赋值* '***************************************************************strLunarMonthName(0) = "正月"strLunarMonthName(2) = "三月"strLunarMonthName(3) = "四月"strLunarMonthName(4) = "五月"strLunarMonthName(5) = "六月"strLunarMonthName(6) = "七月"strLunarMonthName(7) = "八月"strLunarMonthName(8) = "九月"strLunarMonthName(9) = "十月"strLunarMonthName(10) = "冬月"strLunarMonthName(11) = "腊月"'*************************************************************** '* 阴历日子名称数组赋值* '***************************************************************strLunarDayName(0) = "初一"strLunarDayName(1) = "初二"strLunarDayName(2) = "初三"strLunarDayName(3) = "初四"strLunarDayName(4) = "初五"strLunarDayName(5) = "初六"strLunarDayName(6) = "初七"strLunarDayName(7) = "初八"strLunarDayName(8) = "初九"strLunarDayName(9) = "初十"strLunarDayName(10) = "十一"strLunarDayName(11) = "十二"strLunarDayName(12) = "十三"strLunarDayName(13) = "十四"strLunarDayName(14) = "十五"strLunarDayName(15) = "十六"strLunarDayName(16) = "十七"strLunarDayName(17) = "十八"strLunarDayName(18) = "十九"strLunarDayName(19) = "二十"strLunarDayName(20) = "廿一"strLunarDayName(21) = "廿二"strLunarDayName(22) = "廿三"strLunarDayName(23) = "廿四"strLunarDayName(24) = "廿五"strLunarDayName(25) = "廿六"strLunarDayName(26) = "廿七"strLunarDayName(27) = "廿八"strLunarDayName(28) = "廿九"'***************************************************************'* 阴历信息数组赋值*'* 备注第一个数是新年起始天数*'* 备注第二个数是大小月信息*'* 备注第三个数是闰月的月份*'***************************************************************lLunarData(1900) = 4442477 '30 0100101101101 8 1900年阴历信息lLunarData(1901) = 403804 '49 0100101011100lLunarData(1902) = 324782 '39 1010010101110lLunarData(1903) = 2853453 '28 0101001001101 5lLunarData(1904) = 383564 '46 1101001001100lLunarData(1905) = 285482 '34 1101100101010lLunarData(1906) = 2296661 '24 0101101010101 4lLunarData(1907) = 355028 '43 0101011010100lLunarData(1908) = 267098 '32 1001101011010lLunarData(1909) = 1223005 '21 0100101011101 2lLunarData(1910) = 330076 '40 0100101011100lLunarData(1911) = 3388571 '29 1010010011011 6lLunarData(1912) = 398490 '48 1010010011010lLunarData(1913) = 301642 '36 1101001001010lLunarData(1914) = 2833065 '25 1101010101001 5lLunarData(1915) = 366248 '44 1011010101000lLunarData(1916) = 277204 '33 1101011010100lLunarData(1917) = 1233626 '22 1001011011010 2lLunarData(1918) = 340662 '41 1001010110110lLunarData(1919) = 3926327 '31 0100100110111 7lLunarData(1920) = 411950 '50 0100100101110lLunarData(1921) = 316566 '38 1010010010110lLunarData(1922) = 2848331 '27 1011001001011 5lLunarData(1923) = 380234 '46 0110101001010lLunarData(1924) = 290216 '35 0110110101000lLunarData(1925) = 2291125 '23 1010110110101 4lLunarData(1926) = 353644 '43 0010101101100lLunarData(1927) = 266926 '32 1001010101110lLunarData(1928) = 1231151 '22 0100100101111 2lLunarData(1929) = 330030 '40 0100100101110lLunarData(1930) = 3386518 '29 0110010010110 6lLunarData(1931) = 391828 '47 1101010010100lLunarData(1932) = 302410 '36 1110101001010lLunarData(1933) = 2829737 '25 0110110101001 5lLunarData(1934) = 363354 '44 0101101011010lLunarData(1935) = 279916 '34 0010101101100lLunarData(1937) = 340572 '41 1001001011100 lLunarData(1938) = 3922221 '30 1100100101101 7 lLunarData(1939) = 407850 '49 1100100101010 lLunarData(1940) = 318100 '38 1101010010100 lLunarData(1941) = 3365706 '26 1101101001010 6 lLunarData(1942) = 374442 '45 1011010101010 lLunarData(1943) = 289492 '35 0101011010100 lLunarData(1944) = 2299227 '24 1010101011011 4 lLunarData(1945) = 353466 '43 0010010111010 lLunarData(1946) = 266842 '32 1001001011010 lLunarData(1947) = 1227051 '21 1100100101011 2 lLunarData(1948) = 333098 '40 1010100101010 lLunarData(1949) = 3905173 '28 1011010010101 7 lLunarData(1950) = 388500 '47 0110110010100 lLunarData(1951) = 300714 '36 1011010101010 lLunarData(1952) = 2837173 '26 0101010110101 5 lLunarData(1953) = 362932 '44 0100110110100 lLunarData(1954) = 275638 '33 1010010110110 lLunarData(1955) = 1763927 '23 0101001010111 3 lLunarData(1956) = 346710 '42 0101001010110 lLunarData(1957) = 4445482 '30 1010100101010 8 lLunarData(1958) = 400682 '48 1110100101010 lLunarData(1959) = 314708 '38 0110101010100 lLunarData(1960) = 3372458 '27 1010110101010 6 lLunarData(1961) = 374122 '45 1010101101010 lLunarData(1962) = 289132 '35 0100101101100 lLunarData(1963) = 2299054 '24 1010010101110 4 lLunarData(1964) = 357550 '43 1010010101110 lLunarData(1965) = 264780 '32 0101001001100 lLunarData(1966) = 1744166 '20 1110100100110 3 lLunarData(1967) = 326442 '39 1101100101010 lLunarData(1968) = 3910485 '29 0101101010101 7 lLunarData(1969) = 387796 '47 0101011010100 lLunarData(1970) = 299738 '36 1001011011010 lLunarData(1971) = 2836829 '26 0100101011101 5 lLunarData(1972) = 371034 '45 0100101011010 lLunarData(1973) = 275610 '33 1010010011010 lLunarData(1974) = 2284109 '22 1101001001101 4 lLunarData(1975) = 342602 '41 1101001001010 lLunarData(1976) = 4446885 '30 1101010100101 8 lLunarData(1977) = 399016 '48 1011010101000 lLunarData(1978) = 308948 '37 1011011010100 lLunarData(1979) = 3371738 '27 1001011011010 6 lLunarData(1980) = 381622 '46 1001010110110lLunarData(1982) = 2299031 '24 1010010010111 4lLunarData(1983) = 357526 '43 1010010010110lLunarData(1984) = 5510731 '32 1011001001011 10lLunarData(1985) = 413002 '50 0110101001010lLunarData(1986) = 322984 '39 0110110101000lLunarData(1987) = 3380660 '28 1010110110100 6lLunarData(1988) = 390508 '47 1010101101100lLunarData(1989) = 299694 '36 1001010101110lLunarData(1990) = 2836783 '26 0100100101111 5lLunarData(1991) = 370990 '45 0100100101110lLunarData(1992) = 281750 '34 0110010010110lLunarData(1993) = 1756490 '22 0110101001010 3lLunarData(1994) = 335178 '40 1110101001010lLunarData(1995) = 4443493 '30 0110101100101 8lLunarData(1996) = 404312 '49 0101101011000lLunarData(1997) = 308588 '37 1010101101100lLunarData(1998) = 2847341 '27 1001001101101 5lLunarData(1999) = 381532 '46 1001001011100lLunarData(2000) = 293164 '35 1100100101100 2000年阴历信息lLunarData(2001) = 2292629 '23 1101110010101 4lLunarData(2002) = 350868 '42 1101010010100lLunarData(2003) = 260942 '31 1101101001110lLunarData(2004) = 1223509 '21 0101101010101 2lLunarData(2005) = 322260 '39 0101011010100lLunarData(2006) = 3904859 '28 1010101011011 7lLunarData(2007) = 394426 '48 0010010111010lLunarData(2008) = 307802 '37 1001001011010lLunarData(2009) = 2832683 '25 1100100101011 5lLunarData(2010) = 365866 '44 1010100101010 2010年阴历信息lLunarData(2011) = 276116 '33 1011010010100lLunarData(2012) = 2283178 '22 1011010101010 4lLunarData(2013) = 333226 '40 1010110101010lLunarData(2014) = 4967093 '30 0101010110101 9lLunarData(2015) = 403828 '49 0100101110100lLunarData(2016) = 316598 '38 1010010110110lLunarData(2017) = 3369559 '27 0101001010111 6lLunarData(2018) = 379478 '46 0101001010110lLunarData(2019) = 292134 '35 1010100100110lLunarData(2020) = 2297493 '24 0111010010101 4 2020年阴历信息lLunarData(2021) = 347476 '42 0110101010100lLunarData(2022) = 259498 '31 1010110101010lLunarData(2023) = 1223093 '21 0100110110101 2lLunarData(2024) = 330092 '40 0100101101100lLunarData(2025) = 3380398 '28 1010010101110 6lLunarData(2028) = 2833702 '25 1110100100110 5 lLunarData(2029) = 359078 '43 1101010100110 lLunarData(2030) = 273236 '33 0101101010100 lLunarData(2031) = 1756522 '22 0110101101010 3 lLunarData(2032) = 340698 '41 1001011011010 lLunarData(2033) = 6015325 '30 0100101011101 11 lLunarData(2034) = 403802 '49 0100101011010 lLunarData(2035) = 316570 '38 1010010011010 lLunarData(2036) = 3373643 '27 1101001001011 6 lLunarData(2037) = 375370 '45 1101001001010 lLunarData(2038) = 285348 '34 1101010100100 lLunarData(2039) = 2816884 '23 1101101110100 5 lLunarData(2040) = 349876 '42 1011010110100 lLunarData(2041) = 256730 '31 0101011011010 lLunarData(2042) = 1223003 '21 0100101011011 2 lLunarData(2043) = 330038 '40 0100100110110 lLunarData(2044) = 3912855 '29 1010010010111 7 lLunarData(2045) = 390294 '47 1010010010110 lLunarData(2046) = 300362 '36 1010101001010 lLunarData(2047) = 2832037 '25 1011010100101 5 lLunarData(2048) = 363940 '44 0110110100100 lLunarData(2049) = 267700 '32 1010110110100 lLunarData(2050) = 1755830 '22 0101010110110 3 lLunarData(2051) = 340590 '41 1001001101110 lLunarData(2052) = 4450607 '31 0100100101111 8 lLunarData(2053) = 403758 '49 0100100101110 lLunarData(2054) = 314518 '38 0110010010110 lLunarData(2055) = 3370314 '27 0110101001010 6 lLunarData(2056) = 376142 '45 1110101001110 lLunarData(2057) = 281956 '34 0110101100100 lLunarData(2058) = 2291052 '23 1010101101100 4 lLunarData(2059) = 349532 '42 1010101011100 lLunarData(2060) = 266844 '32 1001001011100 lLunarData(2061) = 1743150 '20 1100100101110 3 lLunarData(2062) = 325932 '39 1100100101100 lLunarData(2063) = 3906197 '28 1101010010101 7 lLunarData(2064) = 391828 '47 1101010010100 lLunarData(2065) = 293706 '35 1101101001010 lLunarData(2066) = 2829141 '25 0101101010101 5 lLunarData(2067) = 363220 '44 0101011010100 lLunarData(2068) = 275674 '33 1010011011010 lLunarData(2069) = 2280029 '22 0101001011101 4 lLunarData(2070) = 338522 '41 0101001011010lLunarData(2073) = 308884 '37 1011010010100lLunarData(2074) = 3364522 '26 1011010101010 6lLunarData(2075) = 374186 '45 1010110101010lLunarData(2076) = 289460 '35 0101010110100lLunarData(2077) = 2290874 '23 1010010111010 4lLunarData(2078) = 349366 '42 1010010110110lLunarData(2079) = 264790 '32 0101001010110lLunarData(2080) = 1750311 '21 1010100100111 3lLunarData(2081) = 322854 '39 0110100100110lLunarData(2082) = 3903059 '28 0111001010011 7lLunarData(2083) = 388436 '47 0110101010100lLunarData(2084) = 300458 '36 1010110101010lLunarData(2085) = 2828725 '25 0100110110101 5lLunarData(2086) = 362860 '44 0100101101100lLunarData(2087) = 275630 '33 1010010101110lLunarData(2088) = 2288206 '23 0101001001110 4lLunarData(2089) = 334412 '40 1101001001100lLunarData(2090) = 4439334 '29 1110100100110 8lLunarData(2091) = 400036 '48 1101010100100lLunarData(2092) = 310100 '37 1101101010100lLunarData(2093) = 3362154 '26 0110101101010 6lLunarData(2094) = 371418 '45 0101011011010lLunarData(2095) = 289116 '35 0100101011100lLunarData(2096) = 2299037 '24 1010010011101 4lLunarData(2097) = 349338 '42 1010010011010lLunarData(2098) = 260650 '31 1101000101010lLunarData(2099) = 1219365 '20 1101100100101 2lLunarData(2100) = 326308 '39 1101010100100'*************************************************************** '* 二十四节气名称数组赋值* '***************************************************************strSolarTerms(0) = "小寒"strSolarTerms(1) = "大寒"strSolarTerms(2) = "立春"strSolarTerms(3) = "雨水"strSolarTerms(4) = "惊蛰"strSolarTerms(5) = "春分"strSolarTerms(6) = "清明"strSolarTerms(7) = "谷雨"strSolarTerms(8) = "立夏"strSolarTerms(9) = "小满"strSolarTerms(11) = "夏至"strSolarTerms(12) = "小暑"strSolarTerms(13) = "大暑"strSolarTerms(14) = "立秋"strSolarTerms(15) = "处暑"strSolarTerms(16) = "白露"strSolarTerms(17) = "秋分"strSolarTerms(18) = "寒露"strSolarTerms(19) = "霜降"strSolarTerms(20) = "立冬"strSolarTerms(21) = "小雪"strSolarTerms(22) = "大雪"strSolarTerms(23) = "冬至"'*************************************************************** '* 二十四节气信息数组赋值* '***************************************************************dSolarTermsInfo(0) = 0dSolarTermsInfo(1) = 21208dSolarTermsInfo(2) = 42467dSolarTermsInfo(3) = 63836dSolarTermsInfo(4) = 85337dSolarTermsInfo(5) = 107014dSolarTermsInfo(6) = 128867dSolarTermsInfo(7) = 150921dSolarTermsInfo(8) = 173149dSolarTermsInfo(9) = 195551dSolarTermsInfo(10) = 218072dSolarTermsInfo(11) = 240693dSolarTermsInfo(12) = 263343dSolarTermsInfo(13) = 285009dSolarTermsInfo(14) = 308563dSolarTermsInfo(15) = 331033dSolarTermsInfo(16) = 353350dSolarTermsInfo(17) = 375494dSolarTermsInfo(18) = 397447dSolarTermsInfo(19) = 419210dSolarTermsInfo(20) = 440795dSolarTermsInfo(21) = 462224dSolarTermsInfo(22) = 483532dSolarTermsInfo(23) = 504758End Sub'*************************************************************** '* 获取阳历年固定节日* '* 输入参数是日期的字符串* '* 返回是节日的字符串* '***************************************************************Public Function GetSolarFestivalName(ByVal strDate As String) As StringDim iMonthDay As IntegerDim strSolarFestivalName As StringDim iMonthDayWeek As IntegeriMonthDay = Month(DateValue(strDate)) * 100 + Day(DateValue(strDate)) Select Case iMonthDayCase 101 '一月份的节日、纪念日strSolarFestivalName = "新年元旦"Case 202 '二月份的节日、纪念日strSolarFestivalName = "世界湿地日[1996]"Case 207strSolarFestivalName = "国际声援南非日[1964]"Case 210strSolarFestivalName = "世界气象日[1960]"Case 214strSolarFestivalName = "情人节（Saint Valentine's Day）"Case 215strSolarFestivalName = "中国12亿人口日[1995]"Case 221strSolarFestivalName = "反对殖民制度斗争日[1949]"Case 224strSolarFestivalName = "第三世界青年日"Case 228strSolarFestivalName = "世界居住条件调查日"Case 301 '三月份的节日、纪念日strSolarFestivalName = "国际海豹日[1983]"Case 303strSolarFestivalName = "全国爱耳日[2000]"Case 305strSolarFestivalName = "中国青年志愿者服务日"Case 308strSolarFestivalName = "国际妇女节[1910]"Case 312strSolarFestivalName = "中国植树节[1979] 孙中山逝世纪念日"Case 314strSolarFestivalName = "国际警察日（节）"。

VBA 中的日期计算与格式化指南日期和时间是编程语言中常用的数据类型之一。

在VBA（Visual Basic for Applications）中，你可以使用日期和时间函数来处理日期和时间数据，执行日期计算，以及对日期进行格式化。

本文将向你介绍一些常用的日期计算和格式化方法，帮助你更好地处理日期数据。

一、日期的基本操作在VBA中，你可以使用Date函数来获取当前日期。

例如，`currentDate = Date`会将当前日期赋值给变量currentDate。

你还可以使用Now函数获取当前日期和时间。

你还可以使用DateSerial函数创建一个具体的日期。

DateSerial函数接收年、月和日作为参数，可以用来创建指定日期的变量。

例如，`customDate = DateSerial(2022, 1,1)`会创建一个代表2022年1月1日的日期对象。

二、日期的计算VBA提供了一些函数来进行日期的计算。

1. DateAdd函数DateAdd函数允许你在给定的日期上加上或减去一个指定的时间间隔。

它接收以下参数：- Interval：表示要添加或减去的时间间隔，可以是yyyy （年）、q（季度）、m（月）、y（日）、w（工作日）、d（天）、h（小时）、n（分钟）或s（秒）。

- Number：表示要添加或减去的时间间隔的数量。

- Date：表示要进行计算的日期。

例如，`newDate = DateAdd("d", 7, currentDate)`会将当前日期加上7天后的日期赋值给newDate。

2. DateDiff函数DateDiff函数用于计算两个日期之间的时间间隔。

它接收以下参数：- Interval：表示要计算的时间间隔，可以是yyyy（年）、q（季度）、m（月）、y（日）、w（工作日）、d（天）、h（小时）、n（分钟）或s（秒）。

- StartDate：表示时间间隔的起始日期。