VB中阳历农历日期转换

函数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 Integer
Dim tMonth As Integer
Dim tDay As Integer
Dim i As Integer
tYear = Year(valdate)
tMonth = Month(valdate)
tDay = Day(valdate)
On Error Resume Next
Dim daList(1900 To 2100) As String * 18
Dim conDate As Date, setDate As Date
Dim AddMonth As Integer, AddDay As Integer, AddYear As Integer, getDay As IntegerDim RunYue As Boolean
If tYear > 2100 Or tYear < 1900 Then GoTo yy
yy:
If tYear < 1900 Then
tYear = tYear + 19 * Int((1942 - tYear) / 19)
Else
If tYear > 2100 Then
tYear = tYear - 19 * Int((tYear - 1942) / 19)
End If
End 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、"1
1、"12分别用
A、
B、C来表'''示，即使用16进制。

最后4位为当年家农历新年-即农历1月1日所在公历'''的日期，如0131代表1月31日。

daList
(1900) = "0131"
daList
(1901) = "00219" daList (1902) = "000208" daList (1903) = "50129" daList (1904) = "100216" daList (1905) = "00204" daList (1906) = "140125" daList (1907) = "0213" daList (1908) = "002" daList (1909) = "0122" daList (1910) = "00210" daList (1911) = "60130"
daList (1912) = "000218" daList (1913) = "00206" daList (1914) = "150126" daList (1915) = "00214" daList (1916) = "0204" daList (1917) = "20123" daList (1918) = "00211" daList
(19) = "0201" daList (1920) = "0220" daList (1921) = "00208" daList
(1922) = "" daList (1923) = "000216" daList (1924) = "205" daList (1925) = "40124" daList (1926) = "213" daList (1927) = "0002" daList (1928) = "20123" daList (1929) = "00210" daList (1930) = "" daList (1931) = "0217" daList (1932) = "000206"
daList (1933) = "50126" daList (1934) = "00214" daList (1935) = "204" daList (1936) = "" daList (1937) = "00211" daList (1938) = "0131" daList (1939) = "00219" daList (1940) = "0208" daList (1941) = "60127" daList (1942) = "00215" daList
(1943) = "0205" daList (1944) = "140125" daList (1945) = "00213" daList (1946) = "02" daList (1947) = "20122" daList (1948) = "210" daList (1949) = "70129" daList (1950) = "217" daList (1951) = "00206" daList (1952) = "0127" daList (1953) = "00214"
daList (1954) = "000203" daList (1955) = "30124" daList (1956) = "00212" daList (1957) = "080131" daList (1958) = "000218" daList (1959) = "0208" daList (1960) = "60128" daList (1961) = "00215" daList (1962) = "0205" daList (1963) = "040125" daList
(1964) = "000213" daList (1965) = "202" daList (1966) = "" daList (1967) = "00209" daList (1968) = "0130" daList (1969) = "0217" daList (1970) = "00206" daList (1971) = "50127" daList (1972) = "0215" daList (1973) = "000203" daList (1974) = "040123"
daList (1975) = "00211" daList (1976) = "0131" daList (1977) = "218" daList (1978) = "207" daList (1979) = "160128" daList (1980) = "00216" daList (1981) = "0205" daList (1982) = "040125" daList (1983) = "00213" daList (1984) = "10A02" daList
(1985) = "000220" daList (1986) = "209" daList (1987) = "060129" daList (1988) = "217" daList (1989) = "" daList (1990) = "50127" daList (1991) = "00215" daList (1992) = "" daList (1993) = "30123" daList (1994) = "000210" daList (1995) = "80131"
daList (1996) = "219" daList (1997) = "207" daList (1998) = "50128" daList (1999) = "00216" daList (2000) = "00205" daList (2001) = "40124" daList (2002) = "0212" daList (2003) = "00201" daList (2004) = "020122" daList (2005) = "0209" daList
(2006) = "0129" daList (2007) = "00218" daList (2008) = "0207" daList (2009) = "050126" daList (2010) = "214" daList (2011) = "203" daList (2012) = "040123" daList (2013) = "00210" daList (2014) = "0131" daList (2015) = "00219" daList (2016) = "000208"
daList (2017) = "160128" daList (2018) = "70216" daList (2019) = "00205" daList
(20) = "040125" daList (2021) = "0212" daList (2022) = "00201" daList (2023) = "20122" daList (2024) = "0210" daList (2025) = "60129" daList (2026) = "100217" daList
(2027) = "100206" daList (2028) = "" daList (2029) = "000213" daList (2030) = "0203" daList (2031) = "30123" daList (2032) = "00211" daList (2033) = "30131" daList (2034) = "0219" daList (2035) = "000208" daList (2036) = "060128" daList (2037) = "70215"
daList (2038) = "0204" daList (2039) = "050124" daList (2040) = "212" daList (2041) = "00201" daList (2042) = "020122" daList (2043) = "0210" daList (2044) = "070130" daList (2045) = "00217" daList (2046) = "0206" daList (2047) = "50126" daList
(2048) = "0214"
daList
(2049) = "202"
daList
(2050) = "0123"
AddYear = tYear
RunYue = False
If IsGetGl Then
AddMonth = Val(Mid(daList(AddYear), 15, 2)) AddDay = Val(Mid(daList(AddYear), 17, 2)) conDate = DateSerial(AddYear, AddMonth, AddDay) AddDay = Day(valdate)
tMonth = Month(valdate)
tYear = Year(valdate)
For i = 1 To tMonth - 1
AddDay = AddDay + 29 + Val(Mid(daList(tYear), i, 1)) Next i
setDate = DateAdd("d", AddDay - 1, conDate)
nlgl = setDate
tYear = Year(setDate)
tMonth = Month(setDate)
tDay = Day(setDate)
Exit Function
End If
CHUSHIHUA:
AddMonth = Val(Mid(daList(AddYear), 15, 2))
AddDay = Val(Mid(daList(AddYear), 17, 2))
conDate = DateSerial(AddYear, AddMonth, AddDay)
setDate = DateSerial(tYear, tMonth, tDay)
getDay = DateDiff("d", conDate, setDate)
If getDay < 0 Then AddYear = AddYear - 1: GoTo CHUSHIHUA
' addday = NearDay
AddDay = 1: AddMonth = 1
For i = 1 To getDay
AddDay = AddDay + 1
IfAddDay=30+Mid(daList(AddYear),AddMonth,1)Or(RunYueAndAddDay=30+Mid (daList(AddYear), 13, 1)) Then
If RunYue = False And AddMonth = Val("&H" & Mid(daList(AddYear), 14, 1)) Then
RunYue = True
Else
RunYue = False
AddMonth = AddMonth + 1
End If
AddDay = 1
End If
Next
Dim md$, dd$, mm$
md$="初一初二初三初四初五初六初七初八初九初十十一十二十三十四十五十六十七十八十九二十廿一廿二廿三廿四廿五廿六廿七廿八廿九三十"
dd$ = Mid(md$, (AddDay - 1) * 2 + 1, 2)
mm$ = Mid("正二三四五六七八九十冬腊", AddMonth, 1) + "月"
If RunYue Then mm$ = "闰" + mm$
If IsShort Then
nlgl = Format(RunYue, "0") & Format(AddMonth, "00") & Format(AddDay, "00")Else
nlgl = mm$ + dd$
End If
End Function
Function nly(valdate As Date)
Dim tg As String
Dim dz As String
Dim TianGan$, DiZhi$, AddYear
TianGan$ = "甲乙丙丁戊己庚辛壬癸"
DiZhi$ = "子丑寅卯辰巳午未申酉戌亥"
AddYear = Year(valdate)
tg = Mid(TianGan$, ((AddYear - 4) Mod 10) + 1, 1) dz = Mid(DiZhi$, ((AddYear - 4) Mod 12) + 1, 1) nly = tg & dz & "年"
End Function。