開源EXCEL農曆及24節氣計算

jdwang1000 · 发表于 2017-6-3 10:48

本帖最后由 jdwang1000 于 2017-6-3 12:24 编辑

本程序為以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, 下载次数: 169)

Lunar.rar (257.57 KB, 下载次数: 186)
部分源碼如下

'利用VBA程式求取新月的時間點 ---> 以陣列型式存放運算中資料將比直接放入儲存格中運算速度快上 20倍以上
Sub GetDate_B_VBA(ByVal Start_Year As Integer, ByVal Years As Long, Date_Array As Variant)
Dim I, J, K, K1, K2, K3, K4, Start_Flag, End_Flag As Integer
Dim Main_Year As Double ' 欲查詢的年分
Dim Full_Percent As Single
ReDim Date_Array(Years * 13 + 2, 3) ' 第一維元素 --> 新月日期文字串或EXCEL日期時間格式
' 第二維元素 --> 新月日期 JD 值
' 第三維元素 --> 農曆年份及月份數字代碼 A -10001 012
' A 09997 011
Call Define_Const '呼叫定義宣告公用常數程序以供整體函數及程序使用
'L = timeGetTime ' 使用 Windows API timeGetTime 函數時間精確度可到 10 ms
K = 1
Full_Percent = Years / 100 ' 因為進度條的 Width = 200 所以除以100得到的參數可做為進度條完成率50%的除數
Start_Flag = 0 ' 另外 50% 為24節氣計算時間所用
For I = 0 To Years - 1
End_Flag = 0
J = 2
Main_Year = I + Start_Year - 0.166666667 '以輸入年的前一年11/1為計算的起始點
'( 11/1的年值為0.83333333 -> 年差值為 0.166666667
'Call Solar_Terms ' 呼叫求取24節氣 --> 本年的第一個新月點應該由前一年的12月1日起算較保險
'如果此日期是本國曆年度的第一個新月則 Start_Flag = 1 Else Start_Flag = 2
Do While Start_Flag = 0
Date_Array(1, 2) = New_Moon(Main_Year)
Date_Array(1, 1) = JD_GC(Date_Array(1, 2))
If Find_Date(Date_Array(1, 1)) Then
Start_Flag = 1
J = 2
End If
Main_Year = Main_Year + Year_Step ' Year_Step = 29 / 365 的公用常數
Loop
Do While End_Flag = 0 '設定求取13個新月點求取農曆的初一 End_Flag 為下一年度的一月
K = K + 1
Date_Array(K, 2) = New_Moon(Main_Year)
Do Until (Date_Array(K, 2) - Date_Array(K - 1, 2)) > 1 '若計算出來的新月點JD值與前一個資料相同(同一天)
Main_Year = Main_Year + Year_Step '則再累加29日並重新計算以排除重複日期
Date_Array(K, 2) = New_Moon(Main_Year)
Loop
Date_Array(K, 1) = JD_GC(Date_Array(K, 2))
If J > 11 And End_Flag = 0 Then
If Find_Date(Date_Array(K, 1)) Then End_Flag = J '如果此日期是本國曆年度的第一個新月則寫入第一個新月點陣列
End If
Main_Year = Main_Year + Year_Step
J = J + 1
Loop
Call printCompleted(I / Full_Percent)
Next I
End Sub
'利用VBA程式求取24節氣的時間點, 參數 Solar_Y 是整數值的西元年分 ---> 以陣列型式存放運算中資料將比直接放入儲存格中運算速度快上 20倍以上
Sub Get_Solar_Term(ByVal Start_Year As Integer, ByVal Years As Long, Solar() As Variant)
'Dim Solar(480000, 1) As Variant '宣告陣列維度固定時 ---> 數據少時寫入資料較快 (但資料量若為6000年則固定與Redim相當)
'但若宣告為變量時 ---> 數據少時(1000年以內)運算速度會因 Redim 而增加
'故本程式選擇以變量維度宣告 ---> 數據在50年內可立即顯示不會有停頓
Dim JDEo(2), Solar_S_Angle(2), Solar_S_F(2), Solar_JD(26) As Double
Dim Solar_M, Solar_T, Solar_Trim_T, Solar_a(2), Solar_t_F As Double
Dim Solar_Year_A(2), Solar_Trim_Angle, Yr As Double
Dim I, J, K, S, S_1, S_2 As Integer
Dim Full_Percent As Single
' JDEo(1) -> 前一年的春分點 (二分點二至點)
' JDEo(2) -> 本年度的春分點 (二分點二至點)
' Solar_S_Angle(1) -> 前一年的春分點近點角(以弧度為單位)
' Solar_S_Angle(2) -> 本年度的春分點近點角(以弧度為單位)
' Solar_S_F() -> 前一年及本年度春分點近點角t(θ)函數值 (單位為日) -> 作為與其他節氣點的原點參考值
' Solar_T -> 地球繞日軌道偏心率參數 T = (JD -2451545) / 365250 [ 依春分點的JD值計算 ]
' Solar_M -> 以千年為單位的年值 (有區分 >=1000 -> (Y-2000)/1000 & <1000 -> Y/1000
' Solar_Trim_T -> Function Delta_T(T_Y As Double) As Double 的參數 T_Y (帶小數值的年分) [ 每個節氣均不同 ]
' Solar_a() -> 地球繞日軌道偏心率
' Solar_t_F -> 橢圓軌道公式 t(θ) 的函數值 [ 每個節氣均不同 ]
' Solar_Year_A() -> 回歸年週期 --> 為本年與下一年的JD差值 / 2pi
' Solar_JD(26) -> 每個節氣點的原始JD值
' Solar_Trim_Angle -> 15度增值
Call Define_Const '呼叫定義宣告公用常數程序以供整體函數及程序使用
Full_Percent = Years / 100 ' 因為進度條的 Width = 200 所以除以100得到的參數可做為進度條完成率50%的除數
ReDim Solar(Years * 24, 2) ' 另外 50% 為新月計算時間所用
S = 1
For I = 0 To Years - 1 ' 計算要求區間的節氣時間
' 先計算前一年的末五個節氣再計算本年的前21個節氣
'Yr = Solar_Y + I - 2
Yr = Start_Year + I
Solar_M = Index_Yr(Yr) ' 以1000年為單位的T參數值函數
' 春分點的近點角
Solar_S_Angle(1) = Calculate_S_Angle(Yr / 1000)
' 春分點 JDEo()
JDEo(1) = Calculate_JDEo(Yr, Solar_M)
' 下式為地球繞日軌道偏心率 [ 依Solar_T年份而不同 ]
Solar_T = (JDEo(1) - 2451545) / 365250
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
' 回歸年週期 t/2PI ---> 為本年與下一年的周期
Yr = Start_Year + I + 1
Solar_Year_A(1) = Calculate_JDEo(Yr, Index_Yr(Yr)) - JDEo(1)
' 前一年及本年度的春分點近點角t(θ)函數值 -> 作為與其他節氣點的原點參考值
M_Flag = Index_M_flag(Solar_S_Angle(1))
Solar_S_F(1) = Solar_t_Function(Angle_Filiter(Solar_S_Angle(1)), Solar_Year_A(1), Solar_a(1))
For J = 1 To 24 ' 呼叫函數以計算節氣點 -- > 橢圓軌道公式的θ 是以春分點的進點角累加15度而來
'春分點的近點角加上節氣點的角度並轉為弧度表示
Solar_Trim_Angle = Solar_S_Angle(1) + (J - 1) * M_PI / 12
M_Flag = Index_M_flag(Solar_Trim_Angle)
Solar_Trim_Angle = Angle_Filiter(Solar_Trim_Angle)
' 實際節氣點的t_θ()函數值需再減去春分點的t_θ()函數才是與春分點的日數差
Solar_t_F = Solar_t_Function(Solar_Trim_Angle, Solar_Year_A(1), Solar_a(1))
Solar(S, 2) = JDEo(1) - Solar_S_F(1) + Solar_t_F ' 實際節氣點的原始JD值
Yr = Start_Year + I + (Int(J / 2) + 2.5) / 12 ' 實際節氣點的年值 -> 計算到月
Solar(S, 2) = Solar(S, 2) + Parameter(Solar(S, 2)) - Delta_T(Yr) + 1 / 3 ' 加 1/3 為修正與格林威治的時差
Solar(S, 1) = JD_GC(Solar(S, 2))
S = S + 1
Next J
Call printCompleted(I / Full_Percent + 100)
Next I
End Sub