计算农历日期
网上也有代码的。以下是我修改过的，没有注侍饥释Dim WeekName(7), MonthAdd(11), NongliData(99), TianGan(9), DiZhi(11), ShuXiang(11), DayName(30), MonName(12)Dim curTime, curYear, curMonth, curDay, curWeekdayDim GongliStr, WeekdayStr, NongliStr, NongliMonStr, NongliDayStrDim i, m, n, k, isEnd, bit, TheDate Public Function wYear(curTime As Date, YearOrDay As Integer) 'curTime是传递需要转化的日期,YearOrDay是需要输出什么结果 ' YearOrDay的值是 0=年月日,1=仅农历年枯枯,2=仅月日,3=农历节日 ' 4=仅月,5=仅日 '获取当前系统时间 'curTime = CDate("2008-4-18") '老败返星期名 WeekName(0) = " * " WeekName(1) = "星期日" WeekName(2) = "星期一" WeekName(3) = "星期二" WeekName(4) = "星期三" WeekName(5) = "星期四" WeekName(6) = "星期五" WeekName(7) = "星期六" '天干名称 TianGan(0) = "甲" TianGan(1) = "乙" TianGan(2) = "丙" TianGan(3) = "丁" TianGan(4) = "戊" TianGan(5) = "己" TianGan(6) = "庚" TianGan(7) = "辛" TianGan(8) = "壬" TianGan(9) = "癸" '地支名称 DiZhi(0) = "子" DiZhi(1) = "丑" DiZhi(2) = "寅" DiZhi(3) = "卯" DiZhi(4) = "辰" DiZhi(5) = "巳" DiZhi(6) = "午" DiZhi(7) = "未" DiZhi(8) = "申" DiZhi(9) = "酉" DiZhi(10) = "戌" DiZhi(11) = "亥" '属相名称 ShuXiang(0) = "鼠" ShuXiang(1) = "牛" ShuXiang(2) = "虎" ShuXiang(3) = "兔" ShuXiang(4) = "龙" ShuXiang(5) = "蛇" ShuXiang(6) = "马" ShuXiang(7) = "羊" ShuXiang(8) = "猴" ShuXiang(9) = "鸡" ShuXiang(10) = "狗" ShuXiang(11) = "猪" '农历日期名 DayName(0) = "*" DayName(1) = "初一" DayName(2) = "初二" DayName(3) = "初三" DayName(4) = "初四" DayName(5) = "初五" DayName(6) = "初六" DayName(7) = "初七" DayName(8) = "初八" DayName(9) = "初九" DayName(10) = "初十" DayName(11) = "十一" DayName(12) = "十二" DayName(13) = "十三" DayName(14) = "十四" DayName(15) = "十五" DayName(16) = "十六" DayName(17) = "十七" DayName(18) = "十八" DayName(19) = "十九" DayName(20) = "二十" DayName(21) = "廿一" DayName(22) = "廿二" DayName(23) = "廿三" DayName(24) = "廿四" DayName(25) = "廿五" DayName(26) = "廿六" DayName(27) = "廿七" DayName(28) = "廿八" DayName(29) = "廿九" DayName(30) = "三十" '农历月份名 MonName(0) = "*" MonName(1) = "正" MonName(2) = "二" MonName(3) = "三" MonName(4) = "四" MonName(5) = "五" MonName(6) = "六" MonName(7) = "七" MonName(8) = "八" MonName(9) = "九" MonName(10) = "十" MonName(11) = "十一" MonName(12) = "腊" '公历每月前面的天数 MonthAdd(0) = 0 MonthAdd(1) = 31 MonthAdd(2) = 59 MonthAdd(3) = 90 MonthAdd(4) = 120 MonthAdd(5) = 151 MonthAdd(6) = 181 MonthAdd(7) = 212 MonthAdd(8) = 243 MonthAdd(9) = 273 MonthAdd(10) = 304 MonthAdd(11) = 334 '农历数据 NongliData(0) = 2635 NongliData(1) = 333387 NongliData(2) = 1701 NongliData(3) = 1748 NongliData(4) = 267701 NongliData(5) = 694 NongliData(6) = 2391 NongliData(7) = 133423 NongliData(8) = 1175 NongliData(9) = 396438 NongliData(10) = 3402 NongliData(11) = 3749 NongliData(12) = 331177 NongliData(13) = 1453 NongliData(14) = 694 NongliData(15) = 202326 NongliData(16) = 2350 NongliData(17) = 465197 NongliData(18) = 3221 NongliData(19) = 3402 NongliData(20) = 400202 NongliData(21) = 2901 NongliData(22) = 1386 NongliData(23) = 267611 NongliData(24) = 605 NongliData(25) = 2349 NongliData(26) = 137515 NongliData(27) = 2709 NongliData(28) = 464533 NongliData(29) = 1738 NongliData(30) = 2901 NongliData(31) = 330421 NongliData(32) = 1242 NongliData(33) = 2651 NongliData(34) = 199255 NongliData(35) = 1323 NongliData(36) = 529706 NongliData(37) = 3733 NongliData(38) = 1706 NongliData(39) = 398762 NongliData(40) = 2741 NongliData(41) = 1206 NongliData(42) = 267438 NongliData(43) = 2647 NongliData(44) = 1318 NongliData(45) = 204070 NongliData(46) = 3477 NongliData(47) = 461653 NongliData(48) = 1386 NongliData(49) = 2413 NongliData(50) = 330077 NongliData(51) = 1197 NongliData(52) = 2637 NongliData(53) = 268877 NongliData(54) = 3365 NongliData(55) = 531109 NongliData(56) = 2900 NongliData(57) = 2922 NongliData(58) = 398042 NongliData(59) = 2395 NongliData(60) = 1179 NongliData(61) = 267415 NongliData(62) = 2635 NongliData(63) = 661067 NongliData(64) = 1701 NongliData(65) = 1748 NongliData(66) = 398772 NongliData(67) = 2742 NongliData(68) = 2391 NongliData(69) = 330031 NongliData(70) = 1175 NongliData(71) = 1611 NongliData(72) = 200010 NongliData(73) = 3749 NongliData(74) = 527717 NongliData(75) = 1452 NongliData(76) = 2742 NongliData(77) = 332397 NongliData(78) = 2350 NongliData(79) = 3222 NongliData(80) = 268949 NongliData(81) = 3402 NongliData(82) = 3493 NongliData(83) = 133973 NongliData(84) = 1386 NongliData(85) = 464219 NongliData(86) = 605 NongliData(87) = 2349 NongliData(88) = 334123 NongliData(89) = 2709 NongliData(90) = 2890 NongliData(91) = 267946 NongliData(92) = 2773 NongliData(93) = 592565 NongliData(94) = 1210 NongliData(95) = 2651 NongliData(96) = 395863 NongliData(97) = 1323 NongliData(98) = 2707 NongliData(99) = 265877 '生成当前公历年、月、日 ==> GongliStr curYear = Year(curTime) curMonth = Month(curTime) curDay = Day(curTime) GongliStr = curYear & "年" If (curMonth < 10) Then GongliStr = GongliStr & "0" & curMonth & "月" Else GongliStr = GongliStr & curMonth & "月" End If If (curDay < 10) Then GongliStr = GongliStr & "0" & curDay & "日" Else GongliStr = GongliStr & curDay & "日" End If '生成当前公历星期 ==> WeekdayStr curWeekday = Weekday(curTime) WeekdayStr = WeekName(curWeekday) '计算到初始时间1921年2月8日的天数：1921-2-8(正月初一) TheDate = (curYear - 1921) * 365 + Int((curYear - 1921) / 4) + curDay + MonthAdd(curMonth - 1) - 38 If ((curYear Mod 4) = 0 And curMonth > 2) Then TheDate = TheDate + 1 End If '计算农历天干、地支、月、日 isEnd = 0 m = 0 Do If (NongliData(m) < 4095) Then k = 11 Else k = 12 End If n = k Do If (n < 0) Then Exit Do End If '获取NongliData(m)的第n个二进制位的值 bit = NongliData(m) For i = 1 To n Step 1 bit = Int(bit / 2) Next bit = bit Mod 2If (TheDate <= 29 + bit) Then isEnd = 1 Exit Do End If TheDate = TheDate - 29 - bit n = n - 1 Loop If (isEnd = 1) Then Exit Do End If m = m + 1 Loop curYear = 1921 + m curMonth = k - n + 1 curDay = TheDate If (k = 12) Then If (curMonth = (Int(NongliData(m) / 65536) + 1)) Then curMonth = 1 - curMonth ElseIf (curMonth > (Int(NongliData(m) / 65536) + 1)) Then curMonth = curMonth - 1 End If End If '生成农历天干、地支、属相 ==> NongliStr NongliStr = TianGan(((curYear - 4) Mod 60) Mod 10) & DiZhi(((curYear - 4) Mod 60) Mod 12) & "年" NongliStr = NongliStr & "(" & ShuXiang(((curYear - 4) Mod 60) Mod 12) & ")" 'NongliStr = "农历" & NongliStr NongliStr是农历的年 '生成农历月、日 ==> NongliDayStr If (curMonth < 1) Then NongliDayStr = "闰" & MonName(-1 * curMonth) Else NongliDayStr = MonName(curMonth) End If NongliMonStr = NongliDayStr & "月" NongliDayStr = DayName(curDay) 'NongliDayStr就是月日 'GongliStr = "公历" & GongliStr '这里是公历日期 'wyear = NongliStr & NongliDayStr & vbCrLf & GongliStr 'wyear = NongliStr & NongliDayStr Select Case YearOrDay Case 0 wYear = NongliStr & NongliMonStr & NongliDayStr Case 1 wYear = NongliStr Case 2 wYear = NongliMonStr & NongliDayStr Case 3 Select Case NongliMonStr & NongliDayStr Case "正月初一", "闰正月初一" wYear = "春节" Case "正月十五", "闰正月十五" wYear = "元宵节" Case "五月初五", "闰五月初五" wYear = "端午节" Case "七月初七", "闰七月初七" wYear = "七夕节" Case "七月十五", "闰七月十五" wYear = "中元节" Case "八月十五", "闰八月十五" wYear = "中秋节" Case "九月初九", "闰九月初九" wYear = "重阳节" Case "腊月初八", "闰腊月初八" wYear = "腊八节" Case "腊月廿三", "闰腊月廿三" wYear = "小年" Case "腊月三十", "闰腊月三十" wYear = "除夕" Case Else wYear = "" End Select Case 4 wYear = NongliMonStr Case 5 wYear = NongliDayStr End Select End FunctionFunction sGongliJieri(sD As Date)Dim sJieriDay(100), sJieriName(100)sJieriDay(0) = ""sJieriDay(1) = "0101"sJieriDay(2) = "0202"sJieriDay(3) = "0210"sJieriDay(4) = "0214"sJieriDay(5) = "0301"sJieriDay(6) = "0303"sJieriDay(7) = "0305"sJieriDay(8) = "0308"sJieriDay(9) = "0312"sJieriDay(10) = "0314"sJieriDay(11) = "0315"sJieriDay(12) = "0317"sJieriDay(13) = "0321"sJieriDay(14) = "0322"sJieriDay(15) = "0323"sJieriDay(16) = "0324"sJieriDay(17) = "0325"sJieriDay(18) = "0330"sJieriDay(19) = "0401"sJieriDay(20) = "0407"sJieriDay(21) = "0422"sJieriDay(22) = "0423"sJieriDay(23) = "0424"sJieriDay(24) = "0501"sJieriDay(25) = "0504"sJieriDay(26) = "0505"sJieriDay(27) = "0508"sJieriDay(28) = "0512"sJieriDay(29) = "0515"sJieriDay(30) = "0517"sJieriDay(31) = "0518"sJieriDay(32) = "0520"sJieriDay(33) = "0523"sJieriDay(34) = "0531"sJieriDay(35) = "0601"sJieriDay(36) = "0605"sJieriDay(37) = "0606"sJieriDay(38) = "0617"sJieriDay(39) = "0623"sJieriDay(40) = "0625"sJieriDay(41) = "0626"sJieriDay(42) = "0701"sJieriDay(43) = "0702"sJieriDay(44) = "0707"sJieriDay(45) = "0711"sJieriDay(46) = "0730"sJieriDay(47) = "0801"sJieriDay(48) = "0808"sJieriDay(49) = "0815"sJieriDay(50) = "0908"sJieriDay(51) = "0909"sJieriDay(52) = "0910"sJieriDay(53) = "0914"sJieriDay(54) = "0916"sJieriDay(55) = "0918"sJieriDay(56) = "0920"sJieriDay(57) = "0927"sJieriDay(58) = "0928"sJieriDay(59) = "1001"sJieriDay(60) = "1002"sJieriDay(61) = "1003"sJieriDay(62) = "1004"sJieriDay(63) = "1006"sJieriDay(64) = "1008"sJieriDay(65) = "1009"sJieriDay(66) = "1010"sJieriDay(67) = "1013"sJieriDay(68) = "1014"sJieriDay(69) = "1015"sJieriDay(70) = "1016"sJieriDay(71) = "1017"sJieriDay(72) = "1022"sJieriDay(73) = "1024"sJieriDay(74) = "1031"sJieriDay(75) = "1107"sJieriDay(76) = "1108"sJieriDay(77) = "1109"sJieriDay(78) = "1110"sJieriDay(79) = "1111"sJieriDay(80) = "1112"sJieriDay(81) = "1114"sJieriDay(82) = "1117"sJieriDay(83) = "1120"sJieriDay(84) = "1121"sJieriDay(85) = "1122"sJieriDay(86) = "1129"sJieriDay(87) = "1201"sJieriDay(88) = "1203"sJieriDay(89) = "1205"sJieriDay(90) = "1208"sJieriDay(91) = "1209"sJieriDay(92) = "1210"sJieriDay(93) = "1212"sJieriDay(94) = "1213"sJieriDay(95) = "1220"sJieriDay(96) = "1221"sJieriDay(97) = "1224"sJieriDay(98) = "1225"sJieriDay(99) = "1226"sJieriName(0) = ""sJieriName(1) = "元旦节"sJieriName(2) = "世界湿地日"sJieriName(3) = "国际气象节"sJieriName(4) = "情人节"sJieriName(5) = "国际海豹日"sJieriName(6) = "全国爱耳日"sJieriName(7) = "学雷锋纪念日"sJieriName(8) = "妇女节"sJieriName(9) = "植树节，孙中山逝世纪念日"sJieriName(10) = "国际警察日"sJieriName(11) = "消费者权益日"sJieriName(12) = "中国国医节，国际航海日"sJieriName(13) = "世界森林日，消除种族歧视国际日，世界儿歌日"sJieriName(14) = "世界水日"sJieriName(15) = "世界气象日"sJieriName(16) = "世界防治结核病日"sJieriName(17) = "全国中小学生安全教育日"sJieriName(18) = "巴勒斯坦国土日"sJieriName(19) = "愚人节"sJieriName(20) = "世界卫生日"sJieriName(21) = "世界地球日"sJieriName(22) = "世界图书和版权日"sJieriName(23) = "亚非新闻工作者日"sJieriName(24) = "劳动节"sJieriName(25) = "青年节"sJieriName(26) = "碘缺乏病防治日"sJieriName(27) = "世界红十字日"sJieriName(28) = "国际护士节"sJieriName(29) = "国际家庭日"sJieriName(30) = "国际电信日"sJieriName(31) = "国际博物馆日"sJieriName(32) = "全国学生营养日"sJieriName(33) = "国际牛奶日"sJieriName(34) = "世界无烟日"sJieriName(35) = "国际儿童节"sJieriName(36) = "世界环境保护日"sJieriName(37) = "全国爱眼日"sJieriName(38) = "防治荒漠化和干旱日"sJieriName(39) = "国际奥林匹克日"sJieriName(40) = "全国土地日"sJieriName(41) = "国际禁毒日"sJieriName(42) = "香港回归纪念日，中共诞辰，世界建筑日"sJieriName(43) = "国际体育记者日"sJieriName(44) = "抗日战争纪念日"sJieriName(45) = "世界人口日"sJieriName(46) = "非洲妇女日"sJieriName(47) = "建军节"sJieriName(48) = "中国男子节(爸爸节)"sJieriName(49) = "抗日战争胜利纪念"sJieriName(50) = "国际扫盲日，国际新闻工作者日"sJieriName(51) = "毛泽东逝世纪念"sJieriName(52) = "中国教师节"sJieriName(53) = "世界清洁地球日"sJieriName(54) = "国际臭氧层保护日"sJieriName(55) = "九一八事变纪念日"sJieriName(56) = "国际爱牙日"sJieriName(57) = "世界旅游日"sJieriName(58) = "孔子诞辰"sJieriName(59) = "国庆节音乐日，老人节"sJieriName(60) = "和平与民主自由斗争日"sJieriName(61) = "国庆节假日"sJieriName(62) = "世界动物日"sJieriName(63) = "老人节"sJieriName(64) = "全国高血压日，世界视觉日"sJieriName(65) = "世界邮政日，万国邮联日"sJieriName(66) = "辛亥革命纪念日，世界精神卫生日"sJieriName(67) = "世界保健日，国际教师节"sJieriName(68) = "世界标准日"sJieriName(69) = "国际盲人节(白手杖节)"sJieriName(70) = "世界粮食日"sJieriName(71) = "世界消除贫困日"sJieriName(72) = "世界传统医药日"sJieriName(73) = "联合国日"sJieriName(74) = "世界勤俭日"sJieriName(75) = "十月社会主义革命纪念日"sJieriName(76) = "中国记者日"sJieriName(77) = "全国消防安全宣传教育日"sJieriName(78) = "世界青年节"sJieriName(79) = "国际科学与和平周(本日所属的一周)"sJieriName(80) = "孙中山诞辰纪念日"sJieriName(81) = "世界糖尿病日"sJieriName(82) = "国际大学生节，世界学生节"sJieriName(83) = "彝族年"sJieriName(84) = "世界问候日，世界电视日"sJieriName(85) = "彝族年"sJieriName(86) = "国际声援巴勒斯坦人民国际日"sJieriName(87) = "世界艾滋病日"sJieriName(88) = "世界残疾人日"sJieriName(89) = "国际经济和社会发展志愿人员日"sJieriName(90) = "国际儿童电视日"sJieriName(91) = "世界足球日"sJieriName(92) = "世界人权日"sJieriName(93) = "西安事变纪念日"sJieriName(94) = "南京大屠杀193纪念日"sJieriName(95) = "澳门回归纪念"sJieriName(96) = "国际篮球日"sJieriName(97) = "平安夜"sJieriName(98) = "圣诞节"sJieriName(99) = "毛泽东诞辰纪念"For i = 1 To 99 sJieriDay1 = Left(sJieriDay(i), 2) & "-" & Right(sJieriDay(i), 2) nDay = CInt(CDate(sJieriDay1 & "-" & Year(sD)) - CDate(Month(sD) & "-" & Day(sD) & "-" & Year(sD))) If nDay = 0 Then sGongliJieri = "今天" & sJieriName(i) Exit Function ElseIf nDay > 0 Then sGongliJieri = "差" & nDay & "天" & sJieriName(i) Exit Function End IfNextEnd Function
按农历算
你说的口算法不适合计雹孙算机语言，要在VB里处理还是建议你用楼上的方法，简单、快速。下面给你口算方法，你看下，做个了解，需要一些口算能力，或是算命的，他们整天算这些，超级快。利用公式推算阴历日期： 设：公元年数－1977（或1901）＝4Q＋R 则：阴历日仔局期=14Q+10.6(R+1)+年内日期序数-29.5n （注:式中Q、R、n均为自然数，R<4） 例：1994年5月7日的阴历日期为： 1994－1977＝17＝念肆让4×4＋1 故：Q＝4，R＝1 则：5月7日的阴历日期为： 14×4+10.6(1+1)+(31+28+31+31+7)-29.5n =204.2- 29.5n 然后用29.5去除204.2得商数6......27.2，6即是n值，余数27即是阴历二十七日。
