本頁代碼來源于ExcelHome網(wǎng)站論壇,用于計算24節(jié)氣的日期和時間,計算精度為分鐘。
在這個網(wǎng)站論壇上,由網(wǎng)友zopey發(fā)貼(網(wǎng)址:https://club.excelhome.net/forum.php?mod=viewthread&tid=1390487&_dsign=f5a0e5bd),并由網(wǎng)友YZC51跟帖說,使用這個自定義函數(shù),對1900年至2100年之間的節(jié)氣日期進行驗證,幾乎完全正確,發(fā)現(xiàn)的唯一錯誤是:計算出的1923年“雨水”時間為1923-2-20 0:00,但準確日期應是1923-2-19,相差1天,請原作者予以修正。
原作者在回復中發(fā)了2個截圖,意思說,在“百度”網(wǎng)站中,搜索“1923年農(nóng)歷”,切換到2月份,顯示“雨水”日期的確是2月19日,與自定義函數(shù)計算結(jié)果相差1天;但在“360搜索”網(wǎng)站中,搜索結(jié)果卻是2月20日,與“百度”網(wǎng)站查詢結(jié)果不一致,但與自定義函數(shù)計算結(jié)果相同。這兩個網(wǎng)站有一個數(shù)據(jù)是錯誤的,經(jīng)網(wǎng)友YZC51核實,準確日期是2月19日。
我們知道,計算出的24節(jié)氣時間即使相差1秒,特殊情況下也可能會相差一天!所以,嚴格說來,還得用天文臺的數(shù)據(jù)。
后經(jīng)搜索,網(wǎng)友YZC51在另一個跟貼中(網(wǎng)址:https://club.excelhome.net/thread-819194-9-1.html),上傳了修改后的計算24節(jié)氣自定義函數(shù),現(xiàn)分享給大家。參數(shù)說明及公式應用示例在以下VBA代碼的最上部有介紹,全部代碼如下(以下內(nèi)容除應用截圖外請全部復制到VBA代碼中):
'******************************************************************************************************************************
'功 能:計算24節(jié)氣的日期和時間,誤差不超過1分鐘。
'調(diào)用方法:=GetJQ(年份,節(jié)氣序號,[返回格式])
'******************************************************************************************************************************
'參數(shù)說明及應用示例
'******************************************************************************************************************************
'關(guān)于【年份】參數(shù)
'4位阿拉伯數(shù)字。比如,要計算2024年節(jié)氣日期和時間,【年份】參數(shù)輸入2024。
'
'關(guān)于【節(jié)氣序號】參數(shù):
'農(nóng)歷24節(jié)氣從小寒開始排列,依次是:
'小寒大寒立春雨水驚蟄春分清明谷雨立夏小滿芒種夏至小暑大暑立秋處暑白露秋分寒露霜降立冬小雪大雪冬至
'節(jié)氣序號分別是:0、1、2、3、4、5、6、7、8、9、10、11、12、13、14、15、16、17、18、19、20、21、22、23
'當然,調(diào)用時節(jié)氣序號也可以大于23。比如:24、25、26、27、28......
'示例:=GetJQ(2023,29)
'大于23的節(jié)氣序號可以理解為:把節(jié)氣序號29除以24(共24個節(jié)氣),商的整數(shù)部分為1,表示計算調(diào)用年份2023的下1年,即2024年;
'余數(shù)為5,表示計算序號為5的節(jié)氣,即“春分”
'整個公式表示:計算2023年下1年、第5個節(jié)氣,即2024年“春分”的日期和時間
'返回結(jié)果:2024-03-20 11:06:17.54
'注意哈!不同的計算過程,結(jié)果會有幾秒的誤差。所以,=GetJQ(2023,29) 與 =GetJQ(2024,5)這兩種調(diào)用方法,
' 雖然返回的是同一年、同一個節(jié)氣的日期和時間,但返回結(jié)果的秒數(shù)部分很可能不一樣。
'
'【返回格式】參數(shù)及示例:
' 0,默認值,返回某一節(jié)氣的日期、時間。
' 【示例】計算2024年小寒(序號為0)的日期。
' 公式:=GetJQ(2024,ROW(A1)-1),返回結(jié)果:2024-01-06 04:48:34.54
' 公式中第二參數(shù)使用 ROW(A1)-1 而不用0,是為了便于在表格中拖動復制公式。
' 1,返回某一節(jié)氣的日期、時間、節(jié)氣名稱。
' 【示例】計算2024年立春(序號為2)的日期。
' 公式:=GetJQ(2024,2,1), 返回結(jié)果:2024-02-04 16:26:13.17 立春
' 2,返回某一序號的節(jié)氣名稱。
' 【示例】表格中只要拖動鼠標,就能快速輸入24節(jié)氣名稱。
' 公式:=GetJQ(,ROW(A1)-1,2), 返回結(jié)果:小寒
' 3,只返回某一節(jié)氣的日期,不顯示時間。
' 【示例】計算2024年立春(序號為2)的日期。
' 公式:=GetJQ(2024,2,3), 返回結(jié)果:2024-02-04
' 4,返回帶有小數(shù)的某一節(jié)氣日期的序列數(shù),其整數(shù)部分表示日期的序列值,小數(shù)部分表示時間(時、分、秒)的折算值。
' 【示例】計算2024年立春(序號為2)的序列數(shù)
' 公式:=GetJQ(2024,2,4), 返回結(jié)果:45326.6848746873
'******************************************************************************************************************************
'
Function GetJQ(yy, mm, Optional gs As Integer = 0)
jqmc = "小寒大寒立春雨水驚蟄春分清明谷雨立夏小滿芒種夏至小暑大暑立秋處暑白露秋分寒露霜降立冬小雪大雪冬至"
If gs = 2 Then
GetJQ = Mid(jqmc, (mm Mod 24) * 2 + 1, 2)
Else
v0 = 628.3319653318
t = 0 '第1步迭代
'L0 = (48650621.66 + 6283319653.318 * t) / 10 ^ 7 '原作者筆誤
L0 = (48950621.66 + 6283319653.318 * t) / 10 ^ 7
W = (mm - 5 + (yy - 1999) * 24) * 15 * 3.1415926 / 180 'W指的是太陽黃經(jīng)。1999年春分對應W=0,
'以后每W每增加15度對應下一個節(jié)氣。
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 '地球自轉(zhuǎn)修正項 需完善
JD = J2000 + t * 36525 - deltaT(yy) / 86400 + 8 / 24 '地球自轉(zhuǎn)修正項 已完善
Z = Int(JD + 0.5) '轉(zhuǎn)換日期
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 的誤差。已經(jīng)校正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 = 3 Then GetJQ = getjq1
If gs = 4 Then GetJQ = DateSerial(y1, m1, Int(d1)) + d2 / 86400
'Debug.Print getjq
End If
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
下面是應用截圖:
聯(lián)系客服