ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

快捷登录

搜索
EH技术汇-专业的职场技能充电站 妙哉!函数段子手趣味讲函数 Excel服务器-会Excel,做管理系统 效率神器,一键搞定繁琐工作
HR薪酬管理数字化实战 Excel 2021函数公式学习大典 Excel数据透视表实战秘技 打造核心竞争力的职场宝典
让更多数据处理,一键完成 数据工作者的案头书 免费直播课集锦 ExcelHome出品 - VBA代码宝免费下载
用ChatGPT与VBA一键搞定Excel WPS表格从入门到精通 Excel VBA经典代码实践指南
查看: 3035|回复: 6

[原创] 牛顿迭代法求“二分二至“精确时刻

[复制链接]

TA的精华主题

TA的得分主题

发表于 2019-1-18 15:08 | 显示全部楼层 |阅读模式
VSOP87理论计算出来的几何位置黄经,经过坐标转换,章动修正和光行差修正后,就可以得到比较准确的太阳地心视黄经。
"二分二至"是指春分、秋分、夏至、冬至。历法计算需要根据太阳地心视黄经反求出此时的时间,要做的事情就是求解行星运动轨道方程的根。
牛顿迭代法是一种在实数域和复数域上近似求解方程的方法,因此用到牛顿迭代法,每迭代一次,结果的有效数字将增加一倍

090.JPG

节气与易卦.zip (54.31 KB, 下载次数: 147)

评分

2

查看全部评分

TA的精华主题

TA的得分主题

 楼主| 发表于 2019-1-18 15:08 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册
  1. Function getjq_24(yy, mm)
  2. W = (mm + (yy - 1999) * 24) * 15 * pai / 180
  3. jd1 = earth_t(W - pai) * 365250 + 2451545#

  4. Do
  5.    jd0 = jd1
  6.    stDegree = earth_L(jd0) - W
  7.    stDegreep = (earth_L(jd0 + 0.000005) - earth_L(jd0 - 0.000005)) / 0.00001
  8.    jd1 = jd0 - stDegree / stDegreep
  9. Loop Until Abs(jd1 - jd0) < 0.0000001

  10. getjq_24 = JD2GL(jd1 + 8 / 24 - deltatT(yy) / 86400)
  11. End Function

  12. Function getjq_64(yy, mm)
  13. W = (mm + (yy - 1999) * 64) * 5.625 * pai / 180
  14. jd1 = earth_t(W - pai) * 365250 + 2451545#

  15. Do
  16.    jd0 = jd1
  17.    stDegree = earth_L(jd0) - W
  18.    stDegreep = (earth_L(jd0 + 0.000005) - earth_L(jd0 - 0.000005)) / 0.00001
  19.    jd1 = jd0 - stDegree / stDegreep
  20. Loop Until Abs(jd1 - jd0) < 0.0000001

  21. getjq_64 = JD2GL(jd1 + 8 / 24 - deltatT(yy) / 86400)
  22. End Function
复制代码


TA的精华主题

TA的得分主题

 楼主| 发表于 2019-1-18 17:09 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册
‘求解农历初一

Function getjq_12(yy, mm)
W = (mm + (yy - 2000) * 12) * pai * 2

Do
   jd0 = jd1
   stDegree = moon_L(jd0) - earth_L(jd0) - W
   stDegreep = (moon_L(jd0 + 0.000005) - earth_L(jd0 + 0.000005) - moon_L(jd0 - 0.000005) + earth_L(jd0 - 0.000005)) / 0.00001
   jd1 = jd0 - stDegree / stDegreep
Loop Until Abs(jd1 - jd0) < 0.0000001

getjq_12 = JD2GL(jd1 + 8 / 24 - deltatT(yy) / 86400)
End Function



日月合塑.zip (84.94 KB, 下载次数: 94)

TA的精华主题

TA的得分主题

 楼主| 发表于 2019-1-22 21:19 | 显示全部楼层

TA的精华主题

TA的得分主题

发表于 2019-2-22 20:49 | 显示全部楼层

TA的精华主题

TA的得分主题

 楼主| 发表于 2019-2-26 15:54 | 显示全部楼层
逐年计算 节气的 具体日期:

节气日期变动.zip (116.21 KB, 下载次数: 117)

TA的精华主题

TA的得分主题

发表于 2023-6-22 12:21 | 显示全部楼层
Function JD2GL(JD As Double)         

    'J2000 = 2451545
    '地球自转修正项 需完善
    'JD = J2000
   
    '转换日期
    z = Int(JD + 0.5)
    F = JD + 0.5 - z
   
    a0 = Int((z - 1867216.25) / 36524.25)
    If z < 2299161 Then
       a = z
    Else
       a = z + 1 + a0 - Int(a0 / 4)
    End If
    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 E < 14 Then
      m1 = E - 1
    Else
      m1 = E - 13
    End If
   
    If m1 > 2 Then
      y1 = c - 4716
    Else
      y1 = c - 4715
    End If
   
    d2 = Int((d1 - Int(d1)) * 86400)
    hh1 = Int(d2 / 3600)
   
    mm1 = Int((d2 - hh1 * 3600) / 60)
    If mm1 < 10 Then mm1 = "0" & mm1
    If mm1 = 60 Then mm1 = 59
   
    ss1 = Int((d1 - Int(d1)) * 86400 - hh1 * 3600 - mm1 * 60)
    If ss1 < 10 Then ss1 = "0" & ss1
    If ss1 = 60 Then ss1 = 59
        
    JD2GL = CDate(y1 & "-" & m1 & "-" & Int(d1) & " " & hh1 & ":" & mm1 & ":" & ss1)
End Function

修改了一下,这样才是真正的“日期”数值。
您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

手机版|关于我们|联系我们|ExcelHome

GMT+8, 2024-12-23 04:43 , Processed in 0.035223 second(s), 11 queries , Gzip On, MemCache On.

Powered by Discuz! X3.4

© 1999-2023 Wooffice Inc.

沪公网安备 31011702000001号 沪ICP备11019229号-2

本论坛言论纯属发表者个人意见,任何违反国家相关法律的言论,本站将协助国家相关部门追究发言者责任!     本站特聘法律顾问:李志群律师

快速回复 返回顶部 返回列表