VBA脚本参考
- 'Overall Correction by VBAdvisor on 7/July/2007
- 'I will keep update once I catch any more mistakes.
- '1955-5-21 mistake is due to wrong initial value 457037C,change to 457137C
- '1989-8-1 mistake is due to wrong initial value 93700CE,change to 95700CE
- '2013-6-8 mistake is due to wrong initial value B5500D2,change to AD500D2
- '1916-3-1 mistake is due to wrong initial value 56A00CC,change to D6A00CB
- '1920-12-1 mistake is due to wrong initial value 49B00DC,change to 49700DC
- '2025-5-1 mistake is due to wrong initial value 96E0681,change to A6E0681
- '2033-9-1 mistake is due to wrong initial value 4AB0B83,change to 4AF0B83
- 'Lunar date 1915 has an invalid initial value B5500D6,change to B5400D6
- 'Lunar date 2065 has an invalid initial value DA400CD,change to DA500CD
- 'Lunar date 2068 has an invalid initial value A6C00CB,change to A6D00CB 2069-1-22
- 'Lunar date 2079-1-21 has an invalid initial value 52B00CA,change to 62B00CA
- 'Lunar date 2078 has an invalid initial value A5A00D4,change to A5B00D4
- '农历常量(1899~2100,共202年)
- Private Const LunarTable = "AB500D2,4BD0883," _
- & "4AE00DB,A5700D0,54D0581,D2600D8,D9500CC,655147D,56A00D5,9AD00CA,55D027A,4AE00D2," _
- & "A5B0682,A4D00DA,D2500CE,D25157E,B5400D6,D6A00CB,ADA027B,95B00D3,49717C9,49700DC," _
- & "A4B00D0,B4B0580,6A500D8,6D400CD,AB5147C,2B600D5,95700CA,52F027B,49700D2,6560682," _
- & "D4A00D9,EA500CE,6A9157E,5AD00D6,2B600CC,86E137C,92E00D3,C8D1783,C9500DB,D4A00D0," _
- & "D8A167F,B5500D7,56A00CD,A5B147D,25D00D5,92D00CA,D2B027A,A9500D2,B550781,6CA00D9," _
- & "B5500CE,535157F,4DA00D6,A5B00CB,457137C,52B00D4,A9A0883,E9500DA,6AA00D0,AEA0680," _
- & "AB500D7,4B600CD,AAE047D,A5700D5,52600CA,F260379,D9500D1,5B50782,56A00D9,96D00CE," _
- & "4DD057F,4AD00D7,A4D00CB,D4D047B,D2500D3,D550883,B5400DA,B6A00CF,95A1680,95B00D8," _
- & "49B00CD,A97047D,A4B00D5,B270ACA,6A500DC,6D400D1,AF40681,AB600D9,95700CE,4AF057F," _
- & "49700D7,64B00CC,74A037B,EA500D2,6B50883,5AC00DB,AB600CF,96D0580,92E00D8,C9600CD," _
- & "D95047C,D4A00D4,DA500C9,755027A,56A00D1,ABB0781,25D00DA,92D00CF,CAB057E,A9500D6," _
- & "B4A00CB,BAA047B,AD500D2,55D0983,4BA00DB,A5B00D0,5171680,52B00D8,A9300CD,795047D," _
- & "6AA00D4,AD500C9,5B5027A,4B600D2,A6E0681,A4E00D9,D2600CE,EA6057E,D5300D5,5AA00CB," _
- & "76A037B,96D00D3,4AF0B83,4AD00DB,A4D00D0,D0B1680,D2500D7,D5200CC,DD4057C,B5A00D4," _
- & "56D00C9,55B027A,49B00D2,A570782,A4B00D9,AA500CE,B25157E,6D200D6,ADA00CA,4B6137B," _
- & "93700D3,49F08C9,49700DB,64B00D0,68A1680,EA500D7,6AA00CC,A6C147C,AAE00D4,92E00CA," _
- & "D2E0379,C9600D1,D550781,D4A00D9,DA500CD,5D5057E,56A00D6,A6D00CB,55D047B,52D00D3," _
- & "A9B0883,A9500DB,B4A00CF,B6A067F,AD500D7,55A00CD,ABA047C,A5B00D4,62B00CA,B27037A," _
- & "69300D1,7330781,6AA00D9,AD500CE,4B5157E,4B600D6,A5700CB,54E047C,D1600D2,E960882," _
- & "D5200DA,DAA00CF,6AA167F,56D00D7,4AE00CD,A9D047D,A2D00D4,D1500C9,F250279,D5200D1"
AutoHotkey移植公历转农历函数代码如下(作者:海盗):
- /*
- 公历转农历:
- 输入公历,输出农历
- 农历(天干地支属相日期):=Date_GetLunarDate(公历日期 YYYYMMDD)
- */
- Date_GetLunarDate(Gregorian)
- {
- ;1899年~2100年农历数据
- ;前三位,Hex,转Bin,表示当年月份,1为大月,0为小月
- ;第四位,Dec,表示闰月天数,1为大月30天,0为小月29天
- ;第五位,Hex,转Dec,表示是否闰月,0为不闰,否则为闰月月份
- ;倒数第三位是农历闰几月,直接读取。
- ;倒数第四位也即正数第四位,是闰月天数,1为大 30天, 0为小29天。
- ;举例2017年的5171680的前3位517,转成二进制010100010111,表示当年1-12月大小情况。第5位6,第4位1 表示2017年闰六月 大。
- ;测试用例:20170920 输出八月初一
- ;测试用例:20330828 输出八月初四
- ;农历常量(1899~2100,共202年)
- ;I will keep update once I catch any more mistakes.
- ;1955-5-21 mistake is due to wrong initial value 457037C,change to 457137C
- ;1989-8-1 mistake is due to wrong initial value 93700CE,change to 95700CE
- ;2013-6-8 mistake is due to wrong initial value B5500D2,change to AD500D2
- ;1916-3-1 mistake is due to wrong initial value 56A00CC,change to D6A00CB
- ;1920-12-1 mistake is due to wrong initial value 49B00DC,change to 49700DC
- ;2025-5-1 mistake is due to wrong initial value 96E0681,change to A6E0681
- ;2033-9-1 mistake is due to wrong initial value 4AB0B83,change to 4AF0B83
- ;Lunar date 1915 has an invalid initial value B5500D6,change to B5400D6
- ;Lunar date 2065 has an invalid initial value DA400CD,change to DA500CD
- ;Lunar date 2068 has an invalid initial value A6C00CB,change to A6D00CB 2069-1-22
- ;Lunar date 2079-1-21 has an invalid initial value 52B00CA,change to 62B00CA
- ;Lunar date 2078 has an invalid initial value A5A00D4,change to A5B00D4
- LunarData=
- (LTrim Join
- AB500D2,4AE00DB,A5B0682,A4B00D0,D8A167F,B5500CE,AB500D7,4DD057F,49B00CD,49700D7,D95047C,B4A00CB,6AA00D4,76A037B,56D00C9,93700D3,D2E0379,A9B0883,69300D1,D5200DA,D5200D1
- )
- ;分解公历年月日
- StringLeft,Year,Gregorian,4
- StringMid,Month,5,2
- StringRight,Day,2
- if (Year>2100 Or Year<1900)
- {
- errorinfo=无效日期
- return,errorinfo
- }
- ;获取两年内的农历数据
- Pos:=(Year-1900)*8+1
- StringMid,Data0,LunarData,%Pos%,7
- Pos+=8
- StringMid,Data1,7
- ;判断农历年份
- Analyze(Data1,MonthInfo,LeapInfo,Leap,Newyear)
- Date1=%Year%%Newyear%
- Date2:=Gregorian
- EnvSub,Date2,%Date1%,Days
- If Date2<0 ;和当年农历新年相差的天数
- {
- Analyze(Data0,Newyear)
- Year-=1
- Date1=%Year%%Newyear%
- Date2:=Gregorian
- EnvSub,Days
- }
- ;计算农历日期
- Date2+=1
- LYear:=Year ;农历年份,就是上面计算后的值
- if Leap ;有闰月
- {
- StringLeft,p1,%Leap%
- StringTrimLeft,p2,%Leap%
- thisMonthInfo:=p1 . LeapInfo . p2
- }
- Else
- thisMonthInfo:=MonthInfo
- loop,13
- {
- StringMid,thisMonth,thisMonthInfo,%A_index%,1
- thisDays:=29+thisMonth
- if Date2>%thisDays%
- Date2:=Date2-thisDays
- Else
- {
- if leap
- {
- If leap>%a_index%
- LMonth:=A_index
- Else
- LMonth:=A_index-1
- }
- Else
- LMonth:=A_index
- LDay:=Date2
- Break
- }
- }
- LDate=%LYear%年%LMonth%月%LDay% ;完成
- ;转换成习惯性叫法
- Tiangan=甲,乙,丙,丁,戊,已,庚,辛,壬,癸
- Dizhi=子,丑,寅,卯,辰,巳,午,未,申,酉,戌,亥
- Shengxiao=鼠,牛,虎,兔,龙,蛇,马,羊,猴,鸡,狗,猪
- loop,Parse,Tiangan,`,Tiangan%a_index%:=A_LoopField
- loop,Dizhi,Dizhi%a_index%:=A_LoopField
- loop,Shengxiao,Shengxiao%a_index%:=A_LoopField
- Order1:=Mod((LYear-4),10)+1
- Order2:=Mod((LYear-4),12)+1
- LYear:=Tiangan%Order1% . Dizhi%Order2% . "(" . Shengxiao%Order2% . ")"
- _monthStr=正,二,三,四,五,六,七,八,九,十,冬,腊
- loop,_monthStr,_monthStr%A_index%:=A_LoopField
- LMonth:=_monthStr%LMonth%
- _dayStr=初一,初二,初三,初四,初五,初六,初七,初八,初九,初十,十一,十二,十三,十四,十五,十六,十七,十八,十九,二十,廿一,廿二,廿三,廿四,廿五,廿六,廿七,廿八,廿九,三十
- loop,_dayStr,_dayStr%A_index%:=A_LoopField
- LDay:=_dayStr%LDay%
- LDate=%LYear%年%LMonth%月%LDay%
- Return,LDate
- }
- ;分析农历数据的函数 按上面所示规则分析
- ;4个回参分别对应四项
- Analyze(Data,ByRef rtn1,ByRef rtn2,ByRef rtn3,ByRef rtn4)
- {
- ;rtn1
- StringLeft,Data,3
- rtn1:=ToBase("0x" . Month,2)
- ;517返回10100010111但期望010100010111
- ;~ 补足12位的做法:
- rtn1:=SubStr("000000000000" . rtn1,-11)
- ;rtn2
- StringMid,rtn2,4,1
- ;rtn3
- StringMid,leap,1
- rtn3:=leap<10?leap:ToBase("0x" . leap,10)
- ;rtn4
- StringRight,Newyear,2
- rtn4:=ToBase("0x" . newyear,10)
- rtn4:=SubStr("0000" . rtn4,-3)
- }
- ;进制转换
- ;第一个参数输入数字,0x开头为16进制,无前缀为10进制
- ;第二个参数是 目的进制
- ToBase(n,b){
- return (n < b ? "" : ToBase(n//b,b)) . ((d:=Mod(n,b)) < 10 ? d : Chr(d+55))
- }