现在的大多数代码只能到2010年，其实最关键的一点就是年份的转化，找到了这一点就迎刃而解了！
vb.net 农历 代码
2009-09-21 17:49:05 阅读43 评论1 字号：大中小
在别人的代码上修正了几处错误。
调用：
msgbox(GetYLDate(2009, 9, 21, "", "", False, False))
Module MdlCalendarCN
'下面是一个关于VB的农历算法 2009.09.21 更新：支持 闰月并且是大月的支持
'日期数据定义方法如下
'前12个字节代表1-12月为大月或是小月，1为大月30天，0为小月29天，
'第13位为闰月的情况，1为大月30天，0为小月29天，第14位为闰月的月
'份，如果不是闰月为0，否则给出月份，10、11、12分别用A、B、C来表
'示，即使用16进制。最后4位为当年家农历新年-即农历1月1日所在公历
'的日期，如0131代表1月31日。
'GetYLDate函数使用方式如下tYear为要输入的年，tMonth为月，tDay为
'日期，YLyear是返回值，返加农历的年份，如甲子年，YLShuXing返回
'的是属象，如鼠。IsGetGl是设置是不是通过农历取公历值，如果是，
'前三个返回相应的公历日期，而且返回值是一个公历日期。
Dim i As Integer, md As String, dd As String, mm As String
Dim YouGetDate As Date
Dim tiangan As String, dizhi As String, shu As String
Dim daList(0 To 2100) As String
#Region "——初始化数据——"
Sub FillArr()
'1900 to 1909
daList(1900) = "010010110110180131"
daList(1901) = "010010101110000219"
daList(1902) = "101001010111000208"
daList(1903) = "010100100110150129"
daList(1904) = "110100100110000216"
daList(1905) = "110110010101000204"
daList(1906) = "011010101010140125"
daList(1907) = "010101101010000213"
daList(1908) = "100110101101000202"
daList(1909) = "010010101110120122"
daList(1910) = "010010101110000210"
daList(1911) = "101001001101160130"
daList(1912) = "101001001101000218"
daList(1913) = "110100100101000206"
daList(1914) = "110101010100150126"
daList(1915) = "101101010101000214"
daList(1916) = "010101101010000204"
daList(1917) = "100101101101020123"
daList(1918) = "100101011011000211"
daList(1919) = "010010011011170201"
daList(1920) = "010010011011000220"
daList(1921) = "101001001011000208"
daList(1922) = "101100100101150128"
daList(1923) = "011010100101000216"
daList(1924) = "011011010100000205"
daList(1925) = "101011011010140124"
daList(1926) = "001010110110000213"
daList(1927) = "100101010111000202"
daList(1928) = "010010010111120123"
daList(1929) = "010010010111000210"
daList(1930) = "011001001011060130"
daList(1931) = "110101001010000217"
daList(1932) = "111010100101000206"
daList(1933) = "011011010100150126"
daList(1934) = "010110101101000214"
daList(1935) = "001010110110000204"
daList(1936) = "100100110111030124"
daList(1937) = "100100101110000211"
daList(1938) = "110010010110170131"
daList(1939) = "110010010101000219"
daList(1940) = "110101001010000208"
daList(1941) = "110110100101060127"
daList(1942) = "101101010101000215"
daList(1943) = "010101101010000205"
daList(1944) = "101010101101140125"
daList(1945) = "001001011101000213"
daList(1946) = "100100101101000202"
daList(1947) = "110010010101120122"
daList(1948) = "101010010101000210"
daList(1949) = "101101001010170129"
daList(1950) = "011011001010000217"
daList(1951) = "101101010101000206"
daList(1952) = "010101011010150127"
daList(1953) = "010011011010000214"
daList(1954) = "101001011011000203"
daList(1955) = "010100101011130124"
daList(1956) = "010100101011000212"
daList(1957) = "101010010101080131"
daList(1958) = "111010010101000218"
daList(1959) = "011010101010000208"
daList(1960) = "101011010101060128"
daList(1961) = "101010110101000215"
daList(1962) = "010010110110000205"
daList(1963) = "101001010111040125"
daList(1964) = "101001010111000213"
daList(1965) = "010100100110000202"
daList(1966) = "111010010011030121"
daList(1967) = "110110010101000209"
daList(1968) = "010110101010170130"
daList(1969) = "010101101010000217"
daList(1970) = "100101101101000206"
daList(1971) = "010010101110150127"
daList(1972) = "010010101101000215"
daList(1973) = "101001001101000203"
daList(1974) = "110100100110140123"
daList(1975) = "110100100101000211"
daList(1976) = "110101010010180131"
daList(1977) = "101101010100000218"
daList(1978) = "101101101010000207"
daList(1979) = "100101101101060128"
daList(1980) = "100101011011000216"
daList(1981) = "010010011011000205"
daList(1982) = "101001001011140125"
daList(1983) = "101001001011000213"
daList(1984) = "1011001001011A0202"
daList(1985) = "011010100101000220"
daList(1986) = "011011010100000209"
daList(1987) = "101011011010060129"
daList(1988) = "101010110110000217"
daList(1989) = "100100110111000206"
daList(1990) = "010010010111150127"
daList(1991) = "010010010111000215"
daList(1992) = "011001001011000204"
daList(1993) = "011010100101030123"
daList(1994) = "111010100101000210"
daList(1995) = "011010110010180131"
daList(1996) = "010110101100000219"
daList(1997) = "101010110110000207"
daList(1998) = "100100110110150128"
daList(1999) = "100100101110000216"
daList(2000) = "110010010110000205"
'--
daList(2001) = "110101001010140124" '2009.07.21
daList(2001) = "110110010101040124"
'--
daList(2002) = "110101001010000212"
daList(2003) = "110110100101000201"
'--
daList(2004) = "010110101010120122" '2009.09.21
daList(2004) = "011101010101020122"
'--
daList(2005) = "010101101010000209"
'--
daList(2006) = "101010101101170129" '2009.09.21
daList(2006) = "101010111011070129"
'--
daList(2007) = "001001011101000218"
daList(2008) = "100100101101000207"
'--
daList(2009) = "110010010101150126" '2009-09-03,zjh
daList(2009) = "110010101011050126" '2009.09.21
'--
daList(2010) = "101010010101000214"
daList(2011) = "101101001010000203"
daList(2012) = "101110101010040123"
daList(2013) = "101011010101000210"
daList(2014) = "010101011101090131"
daList(2015) = "010010111010000219"
daList(2016) = "101001011011000208"
'--
daList(2017) = "010100010111160128" '2009.09.21
'--
daList(2018) = "010100101011000216"
daList(2019) = "101010010011000205"
daList(2020) = "011110010101040125"
daList(2021) = "011010101010000212"
daList(2022) = "101011010101000201"
daList(2023) = "010110110101020122"
daList(2024) = "010010110110000210"
daList(2025) = "101001101110060129"
daList(2026) = "101001001110000217"
daList(2027) = "110100100110000206"
daList(2028) = "111010100110050126"
daList(2029) = "110101010011000213"
daList(2030) = "010110101010000203"
daList(2031) = "011101101010030123"
daList(2032) = "100101101101000211"
daList(2033) = "010010111101070131"
daList(2034) = "010010101101000219"
daList(2035) = "101001001101000208"
daList(2036) = "110100001011160128"
daList(2037) = "110100100101000215"
daList(2038) = "110101010010000204"
daList(2039) = "110111010100050124"
daList(2040) = "101101011010000212"
daList(2041) = "010101101101000201"
daList(2042) = "010101011011020122"
daList(2043) = "010010011011000210"
daList(2044) = "101001010111070130"
daList(2045) = "101001001011000217"
daList(2046) = "101010100101000206"
daList(2047) = "101100100101150126"
daList(2048) = "011011010010000214"
daList(2049) = "101011011010000202"
daList(2050) = "010010110110130123"
daList(2051) = "100100110111000211"
daList(2052) = "010010011111080201"
daList(2053) = "010010010111000219"
daList(2054) = "011001001011000208"
daList(2055) = "011010001010160128"
daList(2056) = "111010100101000215"
daList(2057) = "011010110010000204"
daList(2058) = "101001101100140124"
daList(2059) = "101010101110000212"
daList(2060) = "100100101110000202"
daList(2061) = "110100101110030121"
daList(2062) = "110010010110000209"
daList(2063) = "110101010101070129"
daList(2064) = "110101001010000217"
daList(2065) = "110110100101000205"
daList(2066) = "010111010101050126"
daList(2067) = "010101101010000214"
daList(2068) = "101001101101000203"
daList(2069) = "010101011101040123"
daList(2070) = "010100101101000211"
daList(2071) = "101010011011080131"
daList(2072) = "101010010101000219"
daList(2073) = "101101001010000207"
daList(2074) = "101101101010060127"
daList(2075) = "101011010101000215"
daList(2076) = "010101011010000205"
daList(2077) = "101010111010040124"
daList(2078) = "101001011011000212"
daList(2079) = "010100101011000202"
daList(2080) = "101100100111030122"
daList(2081) = "011010010011000209"
daList(2082) = "011100110011070129"
daList(2083) = "011010100110000217"
daList(2084) = "101011010101000206"
daList(2085) = "011010110101050126"
daList(2086) = "010010110110000214"
daList(2087) = "101001010111000203"
daList(2088) = "010101001110040124"
daList(2089) = "110100010110000210"
daList(2090) = "111010010110080130"
daList(2091) = "110101010010000218"
daList(2092) = "110110101010000207"
daList(2093) = "011010101010160127"
daList(2094) = "010101101101000215"
daList(2095) = "010010101110000205"
daList(2096) = "101010011101040125"
daList(2097) = "101000101101000212"
daList(2098) = "110100010101000201"
daList(2099) = "111100100101020121"
daList(2100) = "110101010010000209"
' daList(2101) = "110110110010070129"
' daList(2102) = "101101011010000217"
' daList(2103) = "010101011101000207"
' daList(2104) = "010011011011050128"
' daList(2105) = "010010011011000215"
' daList(2106) = "101001001011000204"
' daList(2107) = "110101001011040124"
' daList(2108) = "101010100101000212"
' daList(2109) = "101101010101090131"
' daList(2110) = "011011010010000219"
' daList(2111) = "101011010110000208"
' daList(2112) = "010101110110060129"
' daList(2113) = "100100110111000216"
' daList(2114) = "010010010111000206"
' daList(2115) = "011010010111040126"
' daList(2116) = "010101001011000214"
' daList(2117) = "011010100101000202"
' daList(2118) = "011110100101030122"
' daList(2119) = "011010101010000210"
' daList(2120) = "101010101010170130"
' daList(2121) = "101010101101000217"
' daList(2122) = "010100101110000207"
' daList(2123) = "110010101110050127"
' daList(2124) = "101010010110000215"
' daList(2125) = "110101001010000203"
' daList(2126) = "111001001010140123"
' daList(2127) = "110110010101000211"
' daList(2128) = "010110101101090201"
' daList(2129) = "010101101010000219"
' daList(2130) = "101001101101000208"
' daList(2131) = "010100011101160129"
' daList(2132) = "010100101101000217"
' daList(2133) = "101010001101000205"
' daList(2134) = "110100010101150125"
' daList(2135) = "101100101010000213"
' daList(2136) = "101101010101000202"
' daList(2137) = "011011010101020100"
' daList(2138) = "010101011010000210"
' daList(2139) = "101001011010170130"
' daList(2140) = "101001011011000218"
' daList(2141) = "010100101011000207"
' daList(2142) = "101010010111050127"
' daList(2143) = "011010001011000215"
' daList(2144) = "011100101001000204"
' daList(2145) = "101110101010040123"
' daList(2146) = "011010110101000211"
' daList(2147) = "0010110110110B0201"
' daList(2148) = "010010110110000220"
' daList(2149) = "101001010111000208"
' daList(2150) = "010100101110060129"
' daList(2151) = "110100010110000216"
' daList(2152) = "111010001011000205"
' daList(2153) = "011011010010050125"
' daList(2154) = "110110101001000212"
' daList(2155) = "010110110101000202"
' daList(2156) = "001101101101030123"
' daList(2157) = "001010101110000210"
' daList(2158) = "101000111101070130"
' daList(2159) = "101000101101000218"
' daList(2160) = "110100010101000207"
' daList(2161) = "110101010101060126"
' daList(2162) = "101101010010000214"
' daList(2163) = "110101101001000203"
' daList(2164) = "010101011010140124"
' daList(2165) = "010101011011000211"
' daList(2166) = "0010101011000A0201"
' daList(2167) = "010001011011000220"
' daList(2168) = "101000101011060128"
' daList(2169) = "101010101011060128"
' daList(2170) = "101010010101000216"
' daList(2171) = "101101001010000205"
' daList(2172) = "101100101010150125"
' daList(2173) = "101011010101000212"
' daList(2174) = "010101011011000202"
' daList(2175) = "001010110111030123"
' daList(2176) = "010001010111000211"
' daList(2177) = "011000110111070130"
' daList(2178) = "010100101011000218"
' daList(2179) = "011010010101000207"
' daList(2180) = "011011010101060127"
' daList(2181) = "010110101010000214"
' daList(2182) = "101010110101000203"
' daList(2183) = "010101101101040124"
' daList(2184) = "010010101110000212"
' daList(2185) = "101001011110080131"
' daList(2186) = "101001010110000219"
' daList(2187) = "110100101010000208"
' daList(2188) = "111010101010060128"
' daList(2189) = "110101010101000215"
' daList(2190) = "010110101010000205"
' daList(2191) = "101011101010050125"
' daList(2192) = "101001101101000213"
' daList(2193) = "010010101110000202"
' daList(2194) = "101010101011030121"
' daList(2195) = "101001001101000210"
' daList(2196) = "110100101011070130"
' daList(2197) = "101100101001000217"
' daList(2198) = "101101010101000206"
' daList(2199) = "010101010101160127"
' daList(2200) = "001011011010000215"
' daList(2201) = "100101011101000204"
' daList(2202) = "010001011011140125"
' daList(2203) = "010010011011000213"
' daList(2204) = "101001001111090202"
' daList(2205) = "011001001011000220"
' daList(2206) = "011010101001000209"
' daList(2207) = "101101101001060129"
' daList(2208) = "011010110101000217"
' daList(2209) = "001010110110000206"
' daList(2210) = "100110110110040126"
' daList(2211) = "100100110111000214"
' daList(2212) = "010010010111000204"
' daList(2213) = "011010010110030123"
' daList(2214) = "111001001010000210"
' daList(2215) = "111010101010070130"
' daList(2216) = "110110101001000218"
' daList(2217) = "010110110111000207"
' daList(2218) = "001011101101050128"
' daList(2219) = "001010101110000216"
' daList(2220) = "100100101110000205"
' daList(2221) = "110000101101140124"
' daList(2222) = "110010010101000212"
' daList(2223) = "110101001101090201"
' daList(2224) = "101101001010000220"
' daList(2225) = "101101101001000208"
' daList(2226) = "010101111010070129"
' daList(2227) = "010101011011000217"
' daList(2228) = "001001011101000207"
' daList(2229) = "100101011011050126"
' daList(2230) = "100100101011000214"
' daList(2231) = "101010010101000203"
' daList(2232) = "110010010101130123"
' daList(2233) = "101101001010000210"
' daList(2234) = "101101011010080130"
' daList(2235) = "101011010101000218"
' daList(2236) = "010101011011000208"
' daList(2237) = "001000110111150128"
' daList(2238) = "001001010111000216"
' daList(2239) = "010100101011000205"
' daList(2240) = "101000101011140125"
' daList(2241) = "011010010101000212"
' daList(2242) = "011011001101090201"
' daList(2243) = "010110101010000220"
' daList(2244) = "101010110101000209"
' daList(2245) = "010010101101160129"
' daList(2246) = "010010101110000217"
' daList(2247) = "101001010111000206"
' daList(2248) = "010101001101050127"
' daList(2249) = "110100100110000213"
' daList(2250) = "111010010101000202"
' daList(2251) = "011101010101030123"
' daList(2252) = "010110101010000211"
' daList(2253) = "101010111010070130"
' daList(2254) = "100101011101000218"
' daList(2255) = "010010101110000208"
' daList(2256) = "101001011011060128"
' daList(2257) = "101001001101000215"
' daList(2258) = "110100100101000204"
' daList(2259) = "110110100101050124"
' daList(2260) = "101101010101000212"
' daList(2261) = "010101101010000201"
' daList(2262) = "101011011010010121"
' daList(2263) = "100101011011000209"
' daList(2264) = "010010110111070130"
' daList(2265) = "010010011011000217"
' daList(2266) = "101001001011000206"
' daList(2267) = "101101001011050126"
' daList(2268) = "011010100101000214"
' daList(2269) = "101011010100000202"
' daList(2270) = "101010110101130122"
' daList(2271) = "001010110110000211"
' daList(2272) = "100101010110180131"
' daList(2273) = "100100110111000218"
' daList(2274) = "010010010111000208"
' daList(2275) = "011001010110060128"
' daList(2276) = "111001001010000215"
' daList(2277) = "111010100101000203"
' daList(2278) = "011010101001140124"
' daList(2279) = "010110101101000212"
' daList(2280) = "001010110110000202"
' daList(2281) = "101010101110020121"
' daList(2282) = "100100101110000209"
' daList(2283) = "110010101101060129"
' daList(2284) = "110010010101000217"
' daList(2285) = "110101001010000205"
' daList(2286) = "110111001010050125"
' daList(2287) = "101101100101000213"
' daList(2288) = "010101101010000203"
' daList(2289) = "101101011011030122"
' daList(2290) = "001001011101000211"
' daList(2291) = "100100111011070131"
' daList(2292) = "100100101011000219"
' daList(2293) = "101010010101000207"
' daList(2294) = "101101010101060127"
' daList(2295) = "011101001010000215"
' daList(2296) = "101101010101000204"
' daList(2297) = "010111010101040124"
' daList(2298) = "010011011010000212"
' daList(2299) = "101001011011000201"
' daList(2300) = "011001010111020122"
End Sub
#End Region
Function GetYLDate(ByVal tYear As Integer, ByVal tMonth As Integer, ByVal tDay As Integer, _
ByVal YLyear As String, ByVal YLShuXing As String, ByVal IsGetGl As Boolean, ByVal ViewFormat As Boolean) As String
'IsGetGl--true（国历） false（农历）
'ViewFormat--true（数字格式） false（文字格式）
On Error Resume Next
Dim conDate As Date, setDate As Date
Dim AddMonth As Integer, AddDay As Integer, AddYear As Integer, getDay As Integer
Dim RunYue As Boolean
If tYear > 2100 Or tYear < 1901 Then
GetYLDate = ""
Exit Function '如果不是有效有日期，退出
End If
Call FillArr() ' 2009.09.21 独立出来
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 = tDay
For i = 1 To tMonth - 1
AddDay = AddDay + 29 + Val(Mid(daList(tYear), i, 1))
Next i
'MsgBox DateDiff("d", conDate, Date)
setDate = DateAdd("d", AddDay - 1, conDate)
GetYLDate = setDate
tYear = Year(setDate)
tMonth = Month(setDate)
tDay = Microsoft.VisualBasic.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
'2009.09.21
Dim tmpAddDay, L As Integer
tmpAddDay = 0
If Mid(daList(AddYear), 13, 1) = "1" Then
tmpAddDay = tmpAddDay + 1
End If
''For i = 1 To getDay
'' AddDay = AddDay + 1
'' 'If AddDay = 30 + Mid(daList(AddYear), AddMonth, 1) Or (RunYue And AddDay = 30 + Mid(daList(AddYear), 13, 1)) Then '2009.09.21
'' If AddDay = 30 + Mid(daList(AddYear), AddMonth, 1) Or (RunYue And AddDay = 30 - tmpAddDay + 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 2009.09.21 改为以下，支持闰月并且是大月
'--2009.09.21
L = 0
For i = 1 To getDay
If L <> 0 Then
AddDay = 1
AddMonth = AddMonth + 1
L = 0
Else
AddDay = AddDay + 1
End If
'If AddDay = 30 + Mid(daList(AddYear), AddMonth, 1) Or (RunYue And AddDay = 30 + Mid(daList(AddYear), 13, 1)) Then '2009.09.21
If AddDay = 30 + Mid(daList(AddYear), AddMonth, 1) Or (RunYue And AddDay = 30 - tmpAddDay + Mid(daList(AddYear), 13, 1)) Then
If (RunYue And AddDay = 30 - tmpAddDay + Mid(daList(AddYear), 13, 1)) Then
'MsgBox("aa")
RunYue = False
If tmpAddDay <> 0 Then
L = L + 1
Else
AddMonth = AddMonth + 1
AddDay = 1
End If
Else
L = 0
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
End If
Next
'--2009.09.21 end
md$ = "初一初二初三初四初五初六初七初八初九初十十一十二十三十四十五十六十七十八十九二十廿一廿二廿三廿四廿五廿六廿七廿八廿九三十"
dd$ = Mid(md$, (AddDay - 1) * 2 + 1, 2)
mm$ = Mid("正二三四五六七八九十寒腊", AddMonth, 1) + "月"
YouGetDate = DateSerial(AddYear, AddMonth, AddDay)
tiangan$ = "甲乙丙丁戊已庚辛壬癸"
dizhi$ = "子丑寅卯辰巳午未申酉戌亥"
Dim ganzhi(0 To 59) As String
For i = 0 To 59
ganzhi(i) = Mid(tiangan$, (i Mod 10) + 1, 1) + Mid(dizhi$, (i Mod 12) + 1, 1)
'ff$ = ff$ + ganzhi(i)
Next i
'MsgBox ff$, , Len(ff$)
YLyear = ganzhi((AddYear - 4) Mod 60)
shu$ = "鼠牛虎兔龙蛇马羊猴鸡狗猪"
YLShuXing = Mid(shu$, ((AddYear - 4) Mod 12) + 1, 1)
If RunYue Then mm$ = "闰" + mm$
If ViewFormat = False Then 'false（文字格式）
GetYLDate = mm$ + dd$
Else
GetYLDate = Format(AddMonth, "00") + Format(AddDay, "00") 'true（数字格式）
End If
End Function
730
被折叠的 条评论
为什么被折叠?
到【灌水乐园】发言
