EXCEL农历函数COM加载宏版真正的万年历(含10000年的农历及24节气信息)

伍成平 · 发表于 2018-1-15 17:48

zopey 发表于 2018-1-6 19:58
http://club.excelhome.net/thread-1389319-1-1.html 9楼公式

你这个也很牛

YZC51 · 发表于 2018-1-15 19:18

伍成平发表于 2018-1-12 20:02
厉害，几行宏代码搞定，能不能不用宏呢，用宏，每次都需要更新

请测试

24节气 (1)-.rar (162.53 KB, 下载次数: 166)

伍成平 · 发表于 2018-1-15 19:41

YZC51 发表于 2018-1-15 19:18
请测试

我原来就是用这个方法的，我的意思是只用一个工作表计算，在原计算表格增加单元格。

伍成平 · 发表于 2018-1-15 19:44

zopey 发表于 2018-1-6 19:58
http://club.excelhome.net/thread-1389319-1-1.html 9楼公式

为什么用文本输出呢，vba我不会，不会从vba里面改成日期格式，花好大功夫用函数改成时间格式了，但看起来好麻烦

YZC51 · 发表于 2018-1-16 09:53

伍成平发表于 2018-1-15 19:44
为什么用文本输出呢，vba我不会，不会从vba里面改成日期格式，花好大功夫用函数改成时间格式了，但看起来 ...

请测试

Function getjq(yy, mm, Optional gs As Integer = 0)
jqmc = "小寒大寒立春雨水惊蛰春分清明谷雨立夏小满芒种夏至小暑大暑立秋处暑白露秋分寒露霜降立冬小雪大雪冬至"
v0 = 628.3319653318
t = 0 '第1步迭代
L0 = (48650621.66 + 6283319653.318 * t) / 10 ^ 7
W = (mm - 5 + (yy - 1999) * 24) * 15 * 3.1415926 / 180 'W指的是太阳黄经。1999年春分对应W=0，
'以后每W每增加15度对应下一个节气。
t = t + (W - L0) / v0 '第2步迭代
t2 = t * t
l1 = (48950621.66 + 6283319653.318 * t + 53 * t2 _
+ 334116 * Cos(4.67 + 628.307585 * t) + 2061 * Cos(2.678 + 628.3076 * t) * t) / 10 ^ 7
v1 = 628.332 + 21 * Sin(1.527 + 628.307585 * t)
t = t + (W - l1) / v1 '第3步迭代
t2 = t * t
t3 = t2 * t
t4 = t3 * t
L2 = (48950621.66 + 6283319653.318 * t + 52.9674 * t2 + 0.00432 * t3 - 0.001124 * t4 _
+ 334166 * Cos(4.669257 + 628.307585 * t) + 3489 * Cos(4.6261 + 1256.61517 * t) _
+ 350 * Cos(2.744 + 575.3385 * t) + 342 * Cos(2.829 + 0.3523 * t) _
+ 314 * Cos(3.628 + 7771.3771 * t) + 268 * Cos(4.418 + 786.0419 * t) _
+ 234 * Cos(6.135 + 393.021 * t) + 132 * Cos(0.742 + 1150.677 * t) _
+ 127 * Cos(2.037 + 52.9691 * t) + 120 * Cos(1.11 + 157.7344 * t) _
+ 99 * Cos(5.23 + 588.493 * t) + 90 * Cos(2.05 + 2.63 * t) _
+ 86 * Cos(3.51 + 39.815 * t) + 78 * Cos(1.18 + 522.369 * t) _
+ 75 * Cos(2.53 + 550.755 * t) + 51 * Cos(4.58 + 1884.923 * t) _
+ 49 * Cos(4.21 + 77.552 * t) + 36 * Cos(2.92 + 0.07 * t) _
+ 32 * Cos(5.85 + 1179.063 * t) + 28 * Cos(1.9 + 79.63 * t) _
+ 27 * Cos(0.31 + 1097.71 * t) + 2060.6 * Cos(2.67823 + 628.307585 * t) * t _
+ 43 * Cos(2.635 + 1256.6152 * t) * t + 8.72 * Cos(1.072 + 628.3076 * t) * t2 _
- 994 - 834 * Sin(2.1824 - 33.75705 * t) _
- 64 * Sin(3.5069 + 1256.66393 * t)) / 10 ^ 7
t = t + (W - L2) / v1 '第4步迭代
J2000 = 2451545
' JD = J2000 + t * 36525 - (64.7 + (yy - 2005) * 0.4) / 86400 + 8 / 24 '地球自转修正项需完善
JD = J2000 + t * 36525 - deltaT(yy) / 86400 + 8 / 24 '地球自转修正项已完善
Z = Int(JD + 0.5) '转换日期
F = JD + 0.5 - Z
a0 = Int((Z - 1867216.25) / 36524.25)
A = Z + 1 + a0 - Int(a0 / 4): If Z < 2299161 Then A = Z
B = A + 1524
C = Int((B - 122.1) / 365.25)
D = Int(365.25 * C)
E = Int((B - D) / 30.6001)
' d1 = B - d - Int(30.6001 * E) + F
If yy = 1923 Then tm = 1.5 / 4320 '此代码用于修正1923-02-20 的误差。已经校正1900-2100年的误差
d1 = B - D - Int(30.6001 * E) + F - tm
m1 = E - 13: If E < 14 Then m1 = E - 1
y1 = C - 4715: If m1 > 2 Then y1 = C - 4716
d2 = (d1 - Int(d1)) * 86400
hh1 = Int(d2 / 3600)
mm1 = Int(((d2 - hh1 * 3600) / 60))
mm2 = ((d2 - hh1 * 3600) / 60)
ss1 = Round((mm2 - mm1) * 60, 2)
getjq1 = y1 & Format(m1, "\-00\-") & Format(Int(d1), "00")
getjq = getjq1 & Format(hh1, " 00") & Format(mm1, "\:00") & Format(ss1, "\:00.00 ")
If gs = 1 Then getjq = getjq & Mid(jqmc, (mm Mod 24) * 2 + 1, 2)
If gs = 2 Then getjq = Mid(jqmc, (mm Mod 24) * 2 + 1, 2)
If gs = 3 Then getjq = getjq1
If gs = 4 Then getjq = DateSerial(y1, m1, Int(d1)) + d2 / 86400
' Debug.Print getjq
End Function
Public Function deltaT(year)
If year >= 2005 And year < 2014 Then
deltaT = 64.7 + (year - 2005) * 0.4
ElseIf year >= 2014 And year < 2114 Then
deltaT = -20 + 31 * ((year - 1820) / 100) ^ 2 _
+ (year - 2114) * ((-20 + 31 * ((2014 - 1820) / 100) ^ 2) _
- (64.7 + (2014 - 2005) * 0.4)) / 100
ElseIf year > 2114 Then
deltaT = -20 + 31 * ((year - 1820) / 100) ^ 2
ElseIf year >= -4000 And year < -500 Then
y1 = -4000: y2 = -500
t = (year - y1) / (y2 - y1) * 10
A = 108371.7: B = -13036.8: C = 392: D = 0
deltaT = A + B * t + C * t ^ 2 + D * t ^ 3
ElseIf year >= -500 And year < -150 Then
y1 = -500: y2 = -150
t = (year - y1) / (y2 - y1) * 10
A = 17201: B = -627.82: C = 16.17: D = -0.3413
deltaT = A + B * t + C * t ^ 2 + D * t ^ 3
ElseIf year >= -150 And year < 150 Then
y1 = -150: y2 = 150
t = (year - y1) / (y2 - y1) * 10
A = 12200.6: B = -346.41: C = 5.403: D = -0.1593
deltaT = A + B * t + C * t ^ 2 + D * t ^ 3
ElseIf year >= 150 And year < 500 Then
y1 = 150: y2 = 500
t = (year - y1) / (y2 - y1) * 10
A = 9113.8: B = -328.13: C = -1.647: D = 0.0377
deltaT = A + B * t + C * t ^ 2 + D * t ^ 3
ElseIf year >= 500 And year < 900 Then
y1 = 500: y2 = 900
t = (year - y1) / (y2 - y1) * 10
A = 5707.5: B = -391.41: C = 0.915: D = 0.3145
deltaT = A + B * t + C * t ^ 2 + D * t ^ 3
ElseIf year >= 900 And year < 1300 Then
y1 = 900: y2 = 1300
t = (year - y1) / (y2 - y1) * 10
A = 2203.4: B = -283.45: C = 13.034: D = -0.1778
deltaT = A + B * t + C * t ^ 2 + D * t ^ 3
ElseIf year >= 1300 And year < 1600 Then
y1 = 1300: y2 = 1600
t = (year - y1) / (y2 - y1) * 10
A = 490.1: B = -57.35: C = 2.085: D = -0.0072
deltaT = A + B * t + C * t ^ 2 + D * t ^ 3
ElseIf year >= 1600 And year < 1700 Then
y1 = 1600: y2 = 1700
t = (year - y1) / (y2 - y1) * 10
A = 120: B = -9.81: C = -1.532: D = 0.1403
deltaT = A + B * t + C * t ^ 2 + D * t ^ 3
ElseIf year >= 1700 And year < 1800 Then
y1 = 1700: y2 = 1800
t = (year - y1) / (y2 - y1) * 10
A = 10.2: B = -0.91: C = 0.51: D = -0.037
deltaT = A + B * t + C * t ^ 2 + D * t ^ 3
ElseIf year >= 1800 And year < 1830 Then
y1 = 1800: y2 = 1830
t = (year - y1) / (y2 - y1) * 10
A = 13.4: B = -0.72: C = 0.202: D = -0.0193
deltaT = A + B * t + C * t ^ 2 + D * t ^ 3
ElseIf year >= 1830 And year < 1860 Then
y1 = 1830: y2 = 1860
t = (year - y1) / (y2 - y1) * 10
A = 7.8: B = -1.81: C = 0.416: D = -0.247
deltaT = A + B * t + C * t ^ 2 + D * t ^ 3
ElseIf year >= 1860 And year < 1880 Then
y1 = 1860: y2 = 1880
t = (year - y1) / (y2 - y1) * 10
A = 8.3: B = -0.13: C = -0.406: D = 0.0292
deltaT = A + B * t + C * t ^ 2 + D * t ^ 3
ElseIf year >= 1880 And year < 1900 Then
y1 = 1880: y2 = 1900
t = (year - y1) / (y2 - y1) * 10
A = -5.4: B = 0.32: C = -0.183: D = 0.0173
deltaT = A + B * t + C * t ^ 2 + D * t ^ 3
ElseIf year >= 1900 And year < 1920 Then
y1 = 1900: y2 = 1920
t = (year - y1) / (y2 - y1) * 10
A = -2.3: B = 2.06: C = 0.169: D = -0.0135
deltaT = A + B * t + C * t ^ 2 + D * t ^ 3
ElseIf year >= 1920 And year < 1940 Then
y1 = 1920: y2 = 1940
t = (year - y1) / (y2 - y1) * 10
A = 21.2: B = 1.69: C = -0.304: D = 0.0167
deltaT = A + B * t + C * t ^ 2 + D * t ^ 3
ElseIf year >= 1940 And year < 1960 Then
y1 = 1940: y2 = 1960
t = (year - y1) / (y2 - y1) * 10
A = 24.2: B = 1.22: C = -0.064: D = 0.0031
deltaT = A + B * t + C * t ^ 2 + D * t ^ 3
ElseIf year >= 1960 And year < 1980 Then
y1 = 1960: y2 = 1980
t = (year - y1) / (y2 - y1) * 10
A = 33.2: B = 0.51: C = 0.231: D = -0.0109
deltaT = A + B * t + C * t ^ 2 + D * t ^ 3
ElseIf year >= 1980 And year < 2000 Then
y1 = 1980: y2 = 2000
t = (year - y1) / (y2 - y1) * 10
A = 51: B = 1.29: C = -0.026: D = 0.0032
deltaT = A + B * t + C * t ^ 2 + D * t ^ 3
ElseIf year >= 2000 And year < 2005 Then
y1 = 2000: y2 = 2005
t = (year - y1) / (y2 - y1) * 10
A = 63.87: B = 0.1: C = 0: D = 0
deltaT = A + B * t + C * t ^ 2 + D * t ^ 3
Else
deltaT = 108372
End If
End Function

复制代码

YZC51 · 发表于 2018-1-16 11:01

附件上传

24节气高精度公式-修订.zip (38.78 KB, 下载次数: 249)

伍成平 · 发表于 2018-1-17 08:00

YZC51 发表于 2018-1-16 09:53
请测试

可以了，非常感谢！

clr1115 · 发表于 2018-1-20 09:48

谢谢分享！！

伍成平 · 发表于 2018-1-21 10:11

YZC51 发表于 2018-1-16 11:01
附件上传

这个表格的代码有没有修改？

YZC51 · 发表于 2018-1-21 10:14

伍成平发表于 2018-1-21 10:11
这个表格的代码有没有修改？

代码修改过的，你可以对照下！

		自动登录	找回密码
密码			免费注册

[原创] EXCEL农历函数COM加载宏版真正的万年历(含10000年的农历及24节气信息)

评分

[原创] EXCEL农历函数COM加载宏版 真正的万年历(含10000年的农历及24节气信息)

评分

[原创] EXCEL农历函数COM加载宏版真正的万年历(含10000年的农历及24节气信息)