開源EXCEL農曆及24節氣計算

jdwang1000

本程序為以VBA計算農曆及24節氣日期並將一年的農曆及節氣資訊壓縮為字串供日後解壓使用
程序為2011年開發完成未經任何優化

資料型態的宣告方式有誤 例 :
Dim JDEo(2), Solar_S_Angle(2), Solar_S_F(2), Solar_JD(26) As Double

只有 Solar_JD(26) 是 Double型態
其餘 JDEo(2), Solar_S_Angle(2), Solar_S_F(2) 則是 Variant 型態

應改為
Dim JDEo(2) As Double, Solar_S_Angle(2) As Double, Solar_S_F(2) As Double, Solar_JD(26) As Double 方為正確的宣告方式

此宣告錯誤請有心者自行更正 !!

附件使用方式為在 Lunar_Code 活頁簿中的 Lunar_Monthly 工作表的 [B1] 及 [B2] 格輸入所需資訊

即可完成計算所需年度的壓縮碼

而在 Lunar 活頁簿中的 Sheet1 工作表的 [M2] 輸入所需年度, 及 [M3] 輸入所需參數 (見 N3~N16 說明)

即可得到所需的農曆,節氣,歷代年號,干支年名稱及生肖或節日資訊

檔案為繁體中文版若在簡體系統中可能會出現亂碼需要自行解決

Lunar_Code.rar (113.78 KB, 下载次数: 179)

2017-6-3 10:46 上传

点击文件名下载附件
EXCEL農曆及24節氣計算

Lunar.rar (257.57 KB, 下载次数: 196)

2017-6-3 12:23 上传

点击文件名下载附件
農曆及24節氣計算驗證

部分源碼如下

1. '利用VBA程式求取新月的時間點  ---> 以陣列型式存放運算中資料將比直接放入儲存格中運算速度快上 20倍 以上
   
2. Sub GetDate_B_VBA(ByVal Start_Year As Integer, ByVal Years As Long, Date_Array As Variant)
   
3.     Dim I, J, K, K1, K2, K3, K4, Start_Flag, End_Flag As Integer
   
4.     Dim Main_Year As Double                 ' 欲查詢的年分
   
5.     Dim Full_Percent As Single
   
6.    
   
7.     ReDim Date_Array(Years * 13 + 2, 3)     ' 第一維元素  --> 新月日期文字串或EXCEL日期時間格式
   
8.                                             ' 第二維元素  --> 新月日期 JD 值
   
9.                                             ' 第三維元素  --> 農曆年份及月份數字代碼 A   -10001  012
   
10.                                             '                                        A    09997  011
    
11.                                             
    
12.     Call Define_Const   '呼叫定義宣告公用常數程序以供整體函數及程序使用
    
13.     'L = timeGetTime ' 使用 Windows API  timeGetTime 函數 時間精確度可到 10 ms
    
14.     K = 1
    
15.     Full_Percent = Years / 100      ' 因為進度條的 Width = 200 所以除以100得到的參數可做為進度條完成率50%的除數
    
16.     Start_Flag = 0                  ' 另外 50% 為24節氣計算時間所用
    
17.     For I = 0 To Years - 1
    
18.         End_Flag = 0
    
19.         J = 2
    
20.         Main_Year = I + Start_Year - 0.166666667            '以輸入年的前一年11/1為計算的起始點
    
21.                                                             '( 11/1的年值為0.83333333 -> 年差值為 0.166666667
    
22.         'Call Solar_Terms    ' 呼叫求取24節氣 --> 本年的第一個新月點應該由前一年的12月1日起算較保險
    
23.         '如果此日期是本國曆年度的第一個新月則 Start_Flag = 1 Else Start_Flag = 2
    
24.         Do While Start_Flag = 0
    
25.             Date_Array(1, 2) = New_Moon(Main_Year)
    
26.             Date_Array(1, 1) = JD_GC(Date_Array(1, 2))
    
27.             If Find_Date(Date_Array(1, 1)) Then
    
28.                 Start_Flag = 1
    
29.                 J = 2
    
30.             End If
    
31.             Main_Year = Main_Year + Year_Step       '  Year_Step = 29 / 365 的公用常數
    
32.         Loop
    
33.         Do While End_Flag = 0                       '設定求取13個新月點 求取農曆的初一 End_Flag 為下一年度的一月
    
34.             K = K + 1
    
35.             Date_Array(K, 2) = New_Moon(Main_Year)
    
36.             Do Until (Date_Array(K, 2) - Date_Array(K - 1, 2)) > 1  '若計算出來的新月點JD值與前一個資料相同(同一天)
    
37.                 Main_Year = Main_Year + Year_Step                   '則再累加29日並重新計算以排除重複日期
    
38.                 Date_Array(K, 2) = New_Moon(Main_Year)
    
39.             Loop
    
40.             Date_Array(K, 1) = JD_GC(Date_Array(K, 2))
    
41.             If J > 11 And End_Flag = 0 Then
    
42.                 If Find_Date(Date_Array(K, 1)) Then End_Flag = J       '如果此日期是本國曆年度的第一個新月則寫入第一個新月點陣列
    
43.             End If
    
44.             Main_Year = Main_Year + Year_Step
    
45.             J = J + 1
    
46.         Loop
    
47.         
    
48.         Call printCompleted(I / Full_Percent)
    
49.     Next I
    
50. End Sub
    
51. 
    
52. 
    
53. '利用VBA程式求取24節氣的時間點, 參數 Solar_Y 是整數值的西元年分  ---> 以陣列型式存放運算中資料將比直接放入儲存格中運算速度快上 20倍 以上
    
54. Sub Get_Solar_Term(ByVal Start_Year As Integer, ByVal Years As Long, Solar() As Variant)
    
55.     'Dim Solar(480000, 1) As Variant    '宣告陣列維度固定時 ---> 數據少時寫入資料較快 (但資料量若為6000年則固定與Redim相當)
    
56.                                         '但若宣告為變量時 ---> 數據少時(1000年以內)運算速度會因 Redim 而增加
    
57.                                         '故本程式選擇以變量維度宣告 ---> 數據在50年內可立即顯示不會有停頓
    
58.     Dim JDEo(2), Solar_S_Angle(2), Solar_S_F(2), Solar_JD(26) As Double
    
59.     Dim Solar_M, Solar_T, Solar_Trim_T, Solar_a(2), Solar_t_F As Double
    
60.     Dim Solar_Year_A(2), Solar_Trim_Angle, Yr As Double
    
61.     Dim I, J, K, S, S_1, S_2 As Integer
    
62.     Dim Full_Percent As Single
    
63.     ' JDEo(1)           -> 前一年的春分點   (二分點二至點)
    
64.     ' JDEo(2)           -> 本年度的春分點   (二分點二至點)
    
65.     ' Solar_S_Angle(1)  -> 前一年的春分點近點角(以弧度為單位)
    
66.     ' Solar_S_Angle(2)  -> 本年度的春分點近點角(以弧度為單位)
    
67.     ' Solar_S_F()       -> 前一年及本年度春分點近點角t(θ)函數值 (單位為日) -> 作為與其他節氣點的原點參考值
    
68.     ' Solar_T           -> 地球繞日軌道偏心率參數  T = (JD -2451545) / 365250 [ 依春分點的JD值計算 ]
    
69.     ' Solar_M           -> 以千年為單位的年值 (有區分 >=1000 -> (Y-2000)/1000  &  <1000 -> Y/1000
    
70.     ' Solar_Trim_T      -> Function Delta_T(T_Y As Double) As Double 的參數 T_Y (帶小數值的年分) [ 每個節氣均不同 ]
    
71.     ' Solar_a()         -> 地球繞日軌道偏心率
    
72.     ' Solar_t_F         -> 橢圓軌道公式 t(θ) 的函數值 [ 每個節氣均不同 ]
    
73.     ' Solar_Year_A()    -> 回歸年週期 --> 為本年與下一年的JD差值 / 2pi
    
74.     ' Solar_JD(26)      -> 每個節氣點的原始JD值
    
75.     ' Solar_Trim_Angle  -> 15度增值
    
76.     Call Define_Const   '呼叫定義宣告公用常數程序以供整體函數及程序使用
    
77.     Full_Percent = Years / 100      ' 因為進度條的 Width = 200 所以除以100得到的參數可做為進度條完成率50%的除數
    
78.     ReDim Solar(Years * 24, 2)                             ' 另外 50% 為新月計算時間所用
    
79.     S = 1
    
80.     For I = 0 To Years - 1   ' 計算要求區間的節氣時間
    
81.                         ' 先計算前一年的末五個節氣再計算本年的前21個節氣
    
82.         'Yr = Solar_Y + I - 2
    
83.         Yr = Start_Year + I
    
84.         Solar_M = Index_Yr(Yr)   ' 以1000年為單位的T參數值函數
    
85.         
    
86.         ' 春分點的近點角
    
87.         Solar_S_Angle(1) = Calculate_S_Angle(Yr / 1000)
    
88.         
    
89.         ' 春分點 JDEo()
    
90.         JDEo(1) = Calculate_JDEo(Yr, Solar_M)
    
91.         
    
92.         ' 下式為地球繞日軌道偏心率 [ 依Solar_T年份而不同 ]
    
93.         Solar_T = (JDEo(1) - 2451545) / 365250
    
94.         Solar_a(1) = 0.0167086342 - 0.0004203654 * Solar_T - 0.0000126734 * Solar_T * Solar_T + 0.0000001444 * Solar_T * Solar_T * Solar_T - 0.0000000002 * Solar_T * Solar_T * Solar_T * Solar_T + 0.0000000003 * Solar_T * Solar_T * Solar_T * Solar_T * Solar_T
    
95.         
    
96.         ' 回歸年週期 t/2PI ---> 為本年與下一年的周期
    
97.         Yr = Start_Year + I + 1
    
98.         Solar_Year_A(1) = Calculate_JDEo(Yr, Index_Yr(Yr)) - JDEo(1)
    
99.         
    
100.         ' 前一年及本年度的春分點近點角t(θ)函數值 -> 作為與其他節氣點的原點參考值
     
101.         M_Flag = Index_M_flag(Solar_S_Angle(1))
     
102.         Solar_S_F(1) = Solar_t_Function(Angle_Filiter(Solar_S_Angle(1)), Solar_Year_A(1), Solar_a(1))
     
103.                
     
104.         For J = 1 To 24      ' 呼叫函數以計算節氣點 -- > 橢圓軌道公式的θ 是以春分點的進點角累加15度而來
     
105.             
     
106.             '春分點的近點角加上節氣點的角度並轉為弧度表示
     
107.             Solar_Trim_Angle = Solar_S_Angle(1) + (J - 1) * M_PI / 12
     
108.             M_Flag = Index_M_flag(Solar_Trim_Angle)
     
109.             Solar_Trim_Angle = Angle_Filiter(Solar_Trim_Angle)
     
110.             
     
111.             ' 實際節氣點的t_θ()函數值需再減去春分點的t_θ()函數才是與春分點的日數差
     
112.             Solar_t_F = Solar_t_Function(Solar_Trim_Angle, Solar_Year_A(1), Solar_a(1))
     
113.             Solar(S, 2) = JDEo(1) - Solar_S_F(1) + Solar_t_F ' 實際節氣點的原始JD值
     
114.             Yr = Start_Year + I + (Int(J / 2) + 2.5) / 12    ' 實際節氣點的年值 -> 計算到月
     
115.             Solar(S, 2) = Solar(S, 2) + Parameter(Solar(S, 2)) - Delta_T(Yr) + 1 / 3       ' 加 1/3 為修正與格林威治的時差
     
116.             Solar(S, 1) = JD_GC(Solar(S, 2))
     
117.             S = S + 1
     
118.         Next J
     
119.         Call printCompleted(I / Full_Percent + 100)
     
120.     Next I
     
121. End Sub
     

复制代码

鄂龙蒙

谢谢！可使用不了。

jdwang1000

鄂龙蒙 发表于 2017-6-3 11:15
谢谢！可使用不了。

下載 Lunar.rar 可直接使用

YZC51

谢谢楼主分享！学习老师优秀作品很有收获。现将已经转为简体应用版的万年历附件奉上。
请各位老师斧正！
原附件存在BUG现已更新！ 天文万年历应用版-去进度条-函数法.rar (432.3 KB, 下载次数: 155)

2017-10-22 19:52 上传

点击文件名下载附件

niko88819

首先先谢谢楼主提供分享！有全英文版本，小师妹英文系统全部不能读或是原代码存成word档案，感谢啰，传到小师妹信箱 niko88819@yahoo.com.my

YZC51

4楼文件已经更新，请各位老师重新下载！

YZC51

修正以下误差：
1914-11-18
应为
1914-11-17

1916-2-4
应为
1916-2-3

1920-11-11
应为
1920-11-10
天文万年历应用校正版-去进度条-函数法.rar (461.37 KB, 下载次数: 94)

2017-10-27 10:25 上传

点击文件名下载附件

aman1516

YZC51 发表于 2017-10-27 10:25
修正以下误差：
1914-11-18
应为

谢谢楼主分享，谢谢 YZC51  改进完善，若改成窗体版，就更完美了

YZC51

修正以下节气误差：
1923-2-20 00:00
应为
1923-2-19

1951-12-22 23:59
应为
1951-12-23
天文万年历应用校正版2-去进度条-函数法.rar (475.39 KB, 下载次数: 177)

2017-10-31 19:37 上传

点击文件名下载附件

jinhaitiao16

我的WPS表格不能用，请版主举例