|
|
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件 ★ 免费下载 ★ ★ 使用帮助★
这个月网上原来的代码出现了日期错误，对比发现daList数组存在大量了定义错误，这个予以修正，并将原来的只到2010年延长到2100年。
Option Compare Database
'2003/6/30 Modify By ligbin
'2009/8/18 Modify By Limpo
Function nlgl(valdate As Date, Optional IsShort As Boolean, Optional IsGetGl As Boolean)
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 Integer
Dim 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
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"
daList(2002) = "110101001010000212"
daList(2003) = "110110100101000201"
daList(2004) = "010110101010120122"
daList(2005) = "010101101010000209"
daList(2006) = "101010101101170129"
daList(2007) = "001001011101000218"
daList(2008) = "100100101101000207"
daList(2009) = "110010101011050126"
daList(2010) = "101010010101000214"
daList(2011) = "101101001010000203"
daList(2012) = "101110101010040123"
daList(2013) = "101011010101000210"
daList(2014) = "010101011101110131"
daList(2015) = "010010111010000219"
daList(2016) = "101001011011000208"
daList(2017) = "010100010111060128"
daList(2018) = "010100101011170216"
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) = "010010101111130131"
daList(2034) = "010010101101000219"
daList(2035) = "101001001101000208"
daList(2036) = "110100001011060128"
daList(2037) = "110100100101170215"
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) = "101100100101050126"
daList(2048) = "011011010010170214"
daList(2049) = "101011011010000202"
daList(2050) = "010010110110030123"
daList(2051) = "100100110111170211"
daList(2052) = "010010011111100201"
daList(2053) = "010010010111000219"
daList(2054) = "011001001011000208"
daList(2055) = "011010001010060128"
daList(2056) = "111010100101170215"
daList(2057) = "011010110010000204"
daList(2058) = "101001101100040124"
daList(2059) = "101010101110170212"
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) = "101010011011100131"
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) = "011010101010000217"
daList(2084) = "101011010101000206"
daList(2085) = "010010110101050126"
daList(2086) = "010010110110170214"
daList(2087) = "101001010111000203"
daList(2088) = "010101001110040124"
daList(2089) = "110100100110000210"
daList(2090) = "111010010110100130"
daList(2091) = "110101010010000218"
daList(2092) = "110110101010000207"
daList(2093) = "011010101010060127"
daList(2094) = "010101101101170215"
daList(2095) = "010010101110000205"
daList(2096) = "101010011101040125"
daList(2097) = "101001001101000212"
daList(2098) = "110100010101000201"
daList(2099) = "111100100101020121"
daList(2100) = "110101010010000209"
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
'MsgBox DateDiff("d", conDate, Date)
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
If AddDay = 30 + Mid(daList(AddYear), AddMonth, 1) Or (RunYue And AddDay = 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
md$ = "初一初二初三初四初五初六初七初八初九初十十一十二十三十四十五十六十七十八十九二十廿一廿二廿三廿四廿五廿六廿七廿八廿九三十"
dd$ = Mid(md$, (AddDay - 1) * 2 + 1, 2)
mm$ = Mid("正二三四五六七八九十冬腊", AddMonth, 1) + "月"
YouGetDate = DateSerial(AddYear, AddMonth, AddDay)
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
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
Function sx(valdate As Date)
AddYear = Year(valdate)
shu$ = "鼠牛虎兔龙蛇马羊猴鸡狗猪"
sx = Mid(shu$, ((AddYear - 4) Mod 12) + 1, 1)
End Function
[ 本帖最后由 Limpo 于 2009-8-19 09:00 编辑 ] |
|
沪公网安备 31011702000001号 沪ICP备11019229号-2
发表于 2009-8-19 08:57
