excel中农历国历的相互转换方法及代码.docx

打开相应的excel表格，按Alt+F11打开VBA编辑器，点击插入插入模块，将下面代码粘贴上去，点击保存后关闭该窗口。接着在相应单元格调用下面四个函数即可实现相应的功能了。适用于1901-2100年间=lunar(2006-11-1)求阳历2006-11-1日对应的阴历=solar(2006-1-1) 求阴历2006年正月初一对应的阳历=lunarbirth(1975-5-6)阴历生日:阳历1975年5月6日出生,今年阴历生日时对应的阳历日期=solarbirth(1975-5-6) 阳历生日:阳历1975年5月6日出生,今年阳历生日时对应的阳历日期1. 阴阳历转换 和 阴阳历生日2. Version: 1.1 2005-9-13. Author: James Zhuang4. Lunar(SolarDate, Part = 0 | 1 | 2 | 3) 阳历转换成阴历5. Part = 0, all; Part = 1, lunar year; Part = 2, lunar month; Part = 3, lunar day6. Solar(LunarDate, LunarMonth = 0 | 1) 阴历转换成阳历7. Type ConvDataA8. leapmonth As Integer9. month(1 To 13) As Integer10. sp_month As Integer Solar month of Spring Festival11. sp_day As Integer Solar day of Spring Festival12. End Type13. Private Function LunarData(q_year) As ConvDataA14. Dim d As Long15. Dim month(1 To 13) As Integer16. 1901-210017. LunarCal = Array(&H4AE53, &HA5748, &H5526BD, &HD2650, &HD9544, &H46AAB9, &H56A4D, &H9AD42, &H24AEB6, &H4AE4A, _18. &H6A4DBE, &HA4D52, &HD2546, &H5D52BA, &HB544E, &HD6A43, &H296D37, &H95B4B, &H749BC1, &H49754, _19. &HA4B48, &H5B25BC, &H6A550, &H6D445, &H4ADAB8, &H2B64D, &H95742, &H2497B7, &H4974A, &H664B3E, _20. &HD4A51, &HEA546, &H56D4BA, &H5AD4E, &H2B644, &H393738, &H92E4B, &H7C96BF, &HC9553, &HD4A48, _21. &H6DA53B, &HB554F, &H56A45, &H4AADB9, &H25D4D, &H92D42, &H2C95B6, &HA954A, &H7B4ABD, &H6CA51, _22. &HB5546, &H555ABB, &H4DA4E, &HA5B43, &H352BB8, &H52B4C, &H8A953F, &HE9552, &H6AA48, &H7AD53C, _23. &HAB54F, &H4B645, &H4A5739, &HA574D, &H52642, &H3E9335, &HD9549, &H75AABE, &H56A51, &H96D46, _24. &H54AEBB, &H4AD4F, &HA4D43, &H4D26B7, &HD254B, &H8D52BF, &HB5452, &HB6A47, &H696D3C, &H95B50, _25. &H49B45, &H4A4BB9, &HA4B4D, &HAB25C2, &H6A554, &H6D449, &H6ADA3D, &HAB651, &H93746, &H5497BB, _26. &H4974F, &H64B44, &H36A537, &HEA54A, &H86B2BF, &H5AC53, &HAB647, &H5936BC, &H92E50, &HC9645, _27. &H4D4AB8, &HD4A4C, &HDA541, &H25AA36, &H56A49, &H7AADBD, &H25D52, &H92D47, &H5C95BA, &HA954E, _28. &HB4A43, &H4B5537, &HAD54A, &H955ABF, &H4BA53, &HA5B48, &H652BBC, &H52B50, &HA9345, &H474AB9, _29. &H6AA4C, &HAD541, &H24DAB6, &H4B64A, &H69573D, &HA4E51, &HD2646, &H5E933A, &HD534D, &H5AA43, _30. &H36B537, &H96D4B, &HB4AEBF, &H4AD53, &HA4D48, &H6D25BC, &HD254F, &HD5244, &H5DAA38, &HB5A4C, _31. &H56D41, &H24ADB6, &H49B4A, &H7A4BBE, &HA4B51, &HAA546, &H5B52BA, &H6D24E, &HADA42, &H355B37, _32. &H9374B, &H8497C1, &H49753, &H64B48, &H66A53C, &HEA54F, &H6B244, &H4AB638, &HAAE4C, &H92E42, _33. &H3C9735, &HC9649, &H7D4ABD, &HD4A51, &HDA545, &H55AABA, &H56A4E, &HA6D43, &H452EB7, &H52D4B, _34. &H8A95BF, &HA9553, &HB4A47, &H6B553B, &HAD54F, &H55A45, &H4A5D38, &HA5B4C, &H52B42, &H3A93B6, _35. &H69349, &H7729BD, &H6AA51, &HAD546, &H54DABA, &H4B64E, &HA5743, &H452738, &HD264A, &H8E933E, _36. &HD5252, &HDAA47, &H66B53B, &H56D4F, &H4AE45, &H4A4EB9, &HA4D4C, &HD1541, &H2D92B5, &HD5349)37. startyear = 190138. ng = LunarCal(q_year - startyear)39. d = &H10000040. LunarData.leapmonth = Int(ng / d)41. ng = ng Mod d42. d = &H8043. mdata = Int(ng / d)44. ng = ng Mod d45. d = &H2046. LunarData.sp_month = Int(ng / d)47. LunarData.sp_day = ng Mod d48. d = &H100049. i = 150. Do51. LunarData.month(i) = 29 + Int(mdata / d)52. mdata = mdata Mod d53. If d = 1 Then Exit Do54. d = d / 255. i = i + 156. Loop57. If LunarData.leapmonth = 0 Then LunarData.month(i) = 058. End Function59. Function lunar(Solar_date As Date, Optional Part As Integer = 0) As String60. Part = 0, all; Part = 1, lunar year; Part = 2, lunar month; Part = 3, lunar day61. Dim a As ConvDataA62. l_year = Year(Solar_date)63. a = LunarData(l_year)64. sp_date = DateSerial(l_year, a.sp_month, a.sp_day)65. If sp_date Solar_date Then66. l_year = l_year - 167. a = LunarData(l_year)68. sp_date = DateSerial(l_year, a.sp_month, a.sp_day)69. End If70. l_day = Solar_date - sp_date71. l_month = 172. IS_lunar_leapmonth = False73. y = a.month(l_month)74. Do While l_day = y75. l_day = l_day - y76. If l_month = a.leapmonth Then IS_lunar_leapmonth = (Not IS_lunar_leapmonth)77. If IS_lunar_leapmonth Then78. y = a.month(13)79. Else80. l_month = l_month + 181. y = a.month(l_month)82. End If83. Loop84. l_day = l_day + 185. lunar = l_year & - & l_month & - & l_day86. If IS_lunar_leapmonth Then lunar = lunar & -L87. lunar = Choose(Part + 1, lunar, l_year, l_month, l_day)88. End Function89. Function solar(Lunar_date, Optional IS_lunar_leapmonth As Integer = 0) As String90. IS_lunar_leapmonth = 0, No leap month; IS_lunar_leapmonth = 1, is leap month91. Dim a As ConvDataA92. Lunar_date = Split(Lunar_date, -)93. s_year = Lunar_date(0)94. For Each C In Lunar_date95. If C = L Then IS_lunar_leapmonth = 196. Next97. a = LunarData(s_year)98. sp_date = DateSerial(s_year, a.sp_month, a.sp_day)99. If Lunar_date(1) a.leapmonth Then IS_lunar_leapmonth = 0100. x = Lunar_date(2)101. tm = Lunar_date(1) + IS_lunar_leapmonth - 1102. For i = 1 To tm103. x = x + a.month(i)104. If i = a.leapmonth And IS_lunar_leapmonth = 0 Then105. x = x + a.month(13)106. End If107. Next108. s_date = sp_date + x - 1109. solar = s_date110. End Function111. Function lunarbirth(Solar_birthday As Date, Optional Inquire_year As Integer) As String112. If Inquire_year = 0 Then113. Inquire_year = Left(lunar(Now), 4)114. lunarbirth = solar(Inquire_year & Mid(lunar(Solar_birthday), 5, 10)115. If CDate(lunarbirth) Now - 1 Then Inquire_year = Inquire_year + 1116. End If117. lunarbirth = solar(Inquire_year & Mid(lunar(Solar_birthday), 5, 10)118. End Function119. Function solarbirth(Solar_birthday As Date, Optional Inquire_year As Integer) As String120. If Inquire_year = 0 Then121. I