关于四柱的自定义函数

YZC51 · 发表于 2018-1-12 09:55

本帖最后由 YZC51 于 2018-1-16 02:00 编辑

声明：
此函数是在zopey等老师所做函数的基础上学习制作。还请各位老师批评指正！谢谢！
Function sizhu(birth As Date) As String
Dim LSJZ
tt$ = "甲子乙丑丙寅丁卯戊辰已巳庚午辛未壬申癸酉甲戌乙亥 " _
      & "丙子丁丑戊寅已卯庚辰辛巳壬午癸未甲申乙酉丙戌丁亥 " _
      & "戊子已丑庚寅辛卯壬辰癸巳甲午乙未丙申丁酉戊戌已亥 " _
      & "庚子辛丑壬寅癸卯甲辰乙巳丙午丁未戊申已酉庚戌辛亥 " _
      & "壬子癸丑甲寅乙卯丙辰丁巳戊午已未庚申辛酉壬戌癸亥 "
LSJZ = Split(tt)
'--------------------------------------------------------------------------------------------以上为变量定义
yy = year(birth): mm = month(birth): dd = Day(birth): hh = Hour(birth)
birth3 = birth + 1 / 24
'-------------------------------------------------------------------------------------------年柱已经调试好
lichun = getjq(yy, 2, 4) '立春
yy1 = yy - 4
If Format(birth, "yyyymmddhhmmss") < Format(getjq(yy, 2, 4), "yyyymmddhhmmss") Then yy1 = yy1 - 1
nzhu = LSJZ(yy1 Mod 60)
'------------------------------------------------------------------------------------------月柱已经调试好
mm1 = mm - 1
jieqi = getjq(yy, mm * 2 - 2, 4)
If Format(birth3, "yyyymmddhhmmss") >= Format(jieqi, "yyyymmddhhmmss") Then mm1 = mm
yzhu = LSJZ((mm1 + (yy Mod 5) * 12 + 12) Mod 60)
'-------------------------------------------------------------------------------------------日柱已经调试好???有错
rcs = (Int(birth) + 8) Mod 60: If hh >= 23 Then rcs = rcs + 1
rzhu = LSJZ(rcs)
'-------------------------------------------------------------------------------------------时柱已经调试好-待精简
szhu = LSJZ(((Int(birth) Mod 5) * 12 + 36 + hh / 2 + 1 / 12) Mod 60) '''
'-------------------------------------------------------------------------------------------结果输出
sizhu = nzhu & "年 " & yzhu & "月 " & rzhu & "日 " & szhu & "时"
End Function

YZC51 · 发表于 2018-1-12 10:34

本帖最后由 YZC51 于 2018-1-19 09:46 编辑

节气函数的附件待完善后，代码已经发表在下面！
Function getjq(yy, mm, Optional gs As Integer = 0)             '经校对并测试1900-2100几无误差-yzc51
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-9-23 18:46

本帖最后由 YZC51 于 2018-9-23 21:25 编辑

上传附件

24节气与四柱八字紫微函数V2.0.rar (77.7 KB, 下载次数: 227)

rxdn8898 · 发表于 2018-9-27 11:29

强大！谢谢分享。

YZC51 · 发表于 2018-9-27 11:52

rxdn8898 发表于 2018-9-27 11:29
强大！谢谢分享。

谢谢老师鼓励！在此为您上传3.5版！

YZC51 · 发表于 2018-9-27 11:53

附件来了！请老师审阅并参考！

24节气与四柱八字紫微版函数V3.5.rar (140.05 KB, 下载次数: 143)

WYS67 · 发表于 2018-11-4 17:12

本帖最后由 WYS67 于 2018-11-4 17:16 编辑

YZC51 发表于 2018-9-27 11:53
附件来了！请老师审阅并参考！

已下载24节气与四柱八字紫微版函数V3.5，果然一看附件就明白了！

假如老师把本帖里的自定义函数代码都附以实例上传，我相信下载学习和使用的更多！如：WLOOKUP和31楼以后的几个，附上实例应用后，下载者肯定更多！

YZC51 · 发表于 2018-11-8 07:02

按节气时刻交割月建的附件，精确到秒！

24节气与四柱八字紫微版函数V3.9.rar (141.29 KB, 下载次数: 183)

zopey · 发表于 2018-11-8 08:36

四柱函数有效日期，公元1900年 -9999年？建议扩大时间范围，可以分析古人八字，
比如网上介绍：朱元璋出生于：1328年10月21日未时（公历），八字排盘是戊辰年，壬戌月，丁丑日，丁未时。

YZC51 · 发表于 2018-11-8 10:36

谢谢老师鼓励，不过学生能力有限恐怕完成不了！哈哈！

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

[讨论] 关于四柱的自定义函数

评分

评分

评分

评分

评分