分享
 
 
 

在access中增加农历支持模块.

王朝other·作者佚名  2006-01-08
窄屏简体版  字體: |||超大  

在access中增加农历支持模块.

新建模块,复制下面两个函数. glgetnl(),strnl()

在查询中使用: select glgetnl(born) as nlborn from empolyee where glgetnl(born)>"05012" order by glgetnl(born)

上面的查询返回农历生日大于五月十二员工列表,并按农历生日排序.

(声明:这两个函数不是从零开始写的,是修改了网上不知道谁的程序代码而来的.

到google输入关键字vb 农历可以找到这篇文章的多处引用

本来是想在ASP中直接调用的,后来想到放到数据库中,但在Access中可以使用,在ASP中使用ADO无法调用.在调试中发现原数据中的1998农历闰月为小月而不是原代码中的大月,另修改了求干支算法.也没去和原作者联系,见谅.)

'输入date, 返回"mmlddyyyy" mm: 月份; l: 1,闰月,0,平常月; dd: 日; yyyy年份

Function glgetnl(ByVal gldate)

Dim daList(111)

'1900 to 1909

daList(0) = "010010110110180131"

daList(1) = "010010101110000219"

daList(2) = "101001010111000208"

daList(3) = "010100100110150129"

daList(4) = "110100100110000216"

daList(5) = "110110010101000204"

daList(6) = "011010101010140125"

daList(7) = "010101101010000213"

daList(8) = "100110101101000202"

daList(9) = "010010101110120122"

daList(10) = "010010101110000210"

daList(11) = "101001001101160130"

daList(12) = "101001001101000218"

daList(13) = "110100100101000206"

daList(14) = "110101010100150126"

daList(15) = "101101010101000214"

daList(16) = "010101101010000204"

daList(17) = "100101101101020123"

daList(18) = "100101011011000211"

daList(19) = "010010011011170201"

daList(20) = "010010011011000220"

daList(21) = "101001001011000208"

daList(22) = "101100100101150128"

daList(23) = "011010100101000216"

daList(24) = "011011010100000205"

daList(25) = "101011011010140124"

daList(26) = "001010110110000213"

daList(27) = "100101010111000202"

daList(28) = "010010010111120123"

daList(29) = "010010010111000210"

daList(30) = "011001001011060130"

daList(31) = "110101001010000217"

daList(32) = "111010100101000206"

daList(33) = "011011010100150126"

daList(34) = "010110101101000214"

daList(35) = "001010110110000204"

daList(36) = "100100110111030124"

daList(37) = "100100101110000211"

daList(38) = "110010010110170131"

daList(39) = "110010010101000219"

daList(40) = "110101001010000208"

daList(41) = "110110100101060127"

daList(42) = "101101010101000215"

daList(43) = "010101101010000205"

daList(44) = "101010101101140125"

daList(45) = "001001011101000213"

daList(46) = "100100101101000202"

daList(47) = "110010010101120122"

daList(48) = "101010010101000210"

daList(49) = "101101001010170129"

daList(50) = "011011001010000217"

daList(51) = "101101010101000206"

daList(52) = "010101011010150127"

daList(53) = "010011011010000214"

daList(54) = "101001011011000203"

daList(55) = "010100101011130124"

daList(56) = "010100101011000212"

daList(57) = "101010010101080131"

daList(58) = "111010010101000218"

daList(59) = "011010101010000208"

daList(60) = "101011010101060128"

daList(61) = "101010110101000215"

daList(62) = "010010110110000205"

daList(63) = "101001010111040125"

daList(64) = "101001010111000213"

daList(65) = "010100100110000202"

daList(66) = "111010010011030121"

daList(67) = "110110010101000209"

daList(68) = "010110101010170130"

daList(69) = "010101101010000217"

daList(70) = "100101101101000206"

daList(71) = "010010101110150127"

daList(72) = "010010101101000215"

daList(73) = "101001001101000203"

daList(74) = "110100100110140123"

daList(75) = "110100100101000211"

daList(76) = "110101010010180131"

daList(77) = "101101010100000218"

daList(78) = "101101101010000207"

daList(79) = "100101101101060128"

daList(80) = "100101011011000216"

daList(81) = "010010011011000205"

daList(82) = "101001001011140125"

daList(83) = "101001001011000213"

daList(84) = "1011001001011A0202"

daList(85) = "011010100101000220"

daList(86) = "011011010100000209"

daList(87) = "101011011010060129"

daList(88) = "101010110110000217"

daList(89) = "100100110111000206"

daList(90) = "010010010111150127"

daList(91) = "010010010111000215"

daList(92) = "011001001011000204"

daList(93) = "011010100101030123"

daList(94) = "111010100101000210"

daList(95) = "011010110010180131"

daList(96) = "010110101100000219"

daList(97) = "101010110110000207"

daList(98) = "100100110110050128"

daList(99) = "100100101110000216"

daList(100) = "110010010110000205"

daList(101) = "110101001010140124"

daList(102) = "110101001010000212"

daList(103) = "110110100101000201"

daList(104) = "010110101010120122"

daList(105) = "010101101010000209"

daList(106) = "101010101101170129"

daList(107) = "001001011101000218"

daList(108) = "100100101101000207"

daList(109) = "110010010101150126"

daList(110) = "101010010101000214"

daList(111) = "101101001010000214"

On Error Resume Next

Dim conDate As Date

Dim tYear, AddMonth, AddDay, AddYear, getDay, i As Integer

Dim RunYue As Boolean

tYear = Year(gldate)

If tYear > 2010 Or tYear < 1901 Then

glgetnl = " "

Exit Function '如果不是有效有日期,退出

End If

RunYue = False

AddYear = tYear

Do

AddMonth = CInt(Mid(daList(AddYear - 1900), 15, 2))

AddDay = CInt(Mid(daList(AddYear - 1900), 17, 2))

conDate = DateSerial(AddYear, AddMonth, AddDay)

getDay = DateDiff("d", conDate, gldate)

If getDay < 0 Then AddYear = AddYear - 1

Loop While getDay < 0

AddDay = 1

AddMonth = 1

For i = 1 To getDay

AddDay = AddDay + 1

If AddDay = 30 + CInt(Mid(daList(AddYear - 1900), AddMonth, 1)) Or (RunYue And AddDay = 30 + CInt(Mid(daList(AddYear - 1900), 13, 1))) Then

If RunYue = False And AddMonth = CInt("&H" & Mid(daList(AddYear - 1900), 14, 1)) Then

RunYue = True

Else

RunYue = False

AddMonth = AddMonth + 1

End If

AddDay = 1

End If

Next

glgetnl = IIf(AddMonth > 9, CStr(AddMonth), "0" + CStr(AddMonth)) + IIf(RunYue, "1", "0") + IIf(AddDay > 9, CStr(AddDay), "0" + CStr(AddDay)) + CStr(AddYear)

End Function

' 输入sNl="mmlddyyyy" mm: 月份; l: 1,闰月,0,平常月; dd: 日; yyyy年份

' 函数返回"XX月XX", 属相存入sShuXinag, 干支记年存入sYear

Function strnl(ByVal sNl, ByRef sShuXiang, ByRef sYear)

Dim lnl_md, lnl_cm, lnl_tiangan, lnl_dizhi, lnl_shu

lnl_md = "初一初二初三初四初五初六初七初八初九初十十一十二十三十四十五十六十七十八十九二十廿一廿二廿三廿四廿五廿六廿七廿八廿九三十"

lnl_cm = "正二三四五六七八九十寒腊"

lnl_tiangan = "甲乙丙丁戊已庚辛壬癸"

lnl_dizhi = "子丑寅卯辰巳午未申酉戌亥"

lnl_shu = "鼠牛虎兔龙蛇马羊猴鸡狗猪"

On Error Resume Next

Dim iy, im, id, isLeap

im = CInt(Left(sNl, 2))

isLeap = CInt(Mid(sNl, 3, 1))

id = CInt(Mid(sNl, 4, 2))

iy = CInt(Right(sNl, 4))

strnl = Mid(lnl_cm, im, 1) & "月" & Mid(lnl_md, (id - 1) * 2 + 1, 2)

If isLeap > 0 Then strnl = "闰" & strnl

iy = iy - 4

sShuXiang = Mid(lnl_shu, (iy Mod 12) + 1, 1)

sYear = Mid(lnl_tiangan, (iy Mod 10) + 1, 1) & Mid(lnl_dizhi, (iy Mod 12) + 1, 1)

End Function

 
 
 
免责声明:本文为网络用户发布,其观点仅代表作者个人观点,与本站无关,本站仅提供信息存储服务。文中陈述内容未经本站证实,其真实性、完整性、及时性本站不作任何保证或承诺,请读者仅作参考,并请自行核实相关内容。
2023年上半年GDP全球前十五强
 百态   2023-10-24
美众议院议长启动对拜登的弹劾调查
 百态   2023-09-13
上海、济南、武汉等多地出现不明坠落物
 探索   2023-09-06
印度或要将国名改为“巴拉特”
 百态   2023-09-06
男子为女友送行,买票不登机被捕
 百态   2023-08-20
手机地震预警功能怎么开?
 干货   2023-08-06
女子4年卖2套房花700多万做美容:不但没变美脸,面部还出现变形
 百态   2023-08-04
住户一楼被水淹 还冲来8头猪
 百态   2023-07-31
女子体内爬出大量瓜子状活虫
 百态   2023-07-25
地球连续35年收到神秘规律性信号,网友:不要回答!
 探索   2023-07-21
全球镓价格本周大涨27%
 探索   2023-07-09
钱都流向了那些不缺钱的人,苦都留给了能吃苦的人
 探索   2023-07-02
倩女手游刀客魅者强控制(强混乱强眩晕强睡眠)和对应控制抗性的关系
 百态   2020-08-20
美国5月9日最新疫情:美国确诊人数突破131万
 百态   2020-05-09
荷兰政府宣布将集体辞职
 干货   2020-04-30
倩女幽魂手游师徒任务情义春秋猜成语答案逍遥观:鹏程万里
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案神机营:射石饮羽
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案昆仑山:拔刀相助
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案天工阁:鬼斧神工
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案丝路古道:单枪匹马
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案镇郊荒野:与虎谋皮
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案镇郊荒野:李代桃僵
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案镇郊荒野:指鹿为马
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案金陵:小鸟依人
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案金陵:千金买邻
 干货   2019-11-12
 
推荐阅读
 
 
 
>>返回首頁<<
 
靜靜地坐在廢墟上,四周的荒凉一望無際,忽然覺得,淒涼也很美
© 2005- 王朝網路 版權所有