excel 阳历日期 转 农历 公式 VBA代码

以下是VBA代码，可用于将阳历日期转换为农历日期：

Function Solar2Lunar(d As Date) As String
    Dim y As Integer, m As Integer, d As Integer
    y = Year(d)
    m = Month(d)
    d = Day(d)
    Dim leap As Integer
    leap = CInt((y Mod 4 = 0 And y Mod 100 <> 0) Or y Mod 400 = 0)
    Dim acc As Variant
    acc = Array(0, 31, 59, 90, 120, 151, 181, 212, 243, 273, 304, 334)
    Dim dayOfYear As Integer
    dayOfYear = acc(m - 1) + d
    If m > 2 Then dayOfYear = dayOfYear + leap
    Dim lunarMonth As Integer, lunarDay As Integer
    Dim i As Integer
    For i = 1 To 12
        If dayOfYear > LunarDaysOfMonth(leap, i) Then
            dayOfYear = dayOfYear - LunarDaysOfMonth(leap, i)
        Else
            lunarMonth = i
            lunarDay = dayOfYear
            Exit For
        End If
    Next i
    Solar2Lunar = LunarMonthName(lunarMonth) & LunarDayName(lunarDay - 1)
End Function

Function LunarDaysOfMonth(leap As Integer, month As Integer) As Integer
    Dim lunarDaysPerMonth As Variant
    lunarDaysPerMonth = Array(29, 30)
    If leap = 1 And month = 2 Then LunarDaysOfMonth = 29 Else LunarDaysOfMonth = lunarDaysPerMonth((29.5 >> month) And 1)
End Function

Function LunarMonthName(month As Integer) As String
    Dim lunarMonthNames As Variant
    lunarMonthNames = Array("正月", "二月", "三月", "四月", "五月", "六月", "七月", "八月", "九月", "十月", "十一月", "十二月")
    LunarMonthName = lunarMonthNames(month - 1)
End Function

Function LunarDayName(day As Integer) As String
    Dim lunarDayNames As Variant
    lunarDayNames = Array("初一", "初二", "初三", "初四", "初五", "初六", "初七", "初八", "初九", "初十", "十一", "十二", "十三", "十四", "十五", "十六", "十七", "十八", "十九", "二十", "廿一", "廿二", "廿三", "廿四", "廿五", "廿六", "廿七", "廿八", "廿九", "三十")
    LunarDayName = lunarDayNames(day)
End Function

使用方法：

将上述代码复制到VBA编辑器中，然后在Excel中使用以下公式（假设阳历日期在A1单元格中）：

=Solar2Lunar(A1)

该公式将返回对应的农历日期。