农历计算程序

zopey

1. Dim arr1, arr2, brr1, brr2
   
2. Sub testa()
   
3. '“气”直线拟合参数
   
4. arr1 = Array( _
   
5. 1640650.479938, 1642476.703182, 1683430.515601, 1752157.640664, 1807675.003759, 1883627.765182, 1907369.1281, 1936603.140413, _
   
6. 1939145.52418, 1947180.7983, 1964362.041824, 1987372.340971, 1999653.819126, 2007445.469786, 2021324.917146, 2047257.232342, _
   
7. 2070282.898213, 2073204.87285, 2080144.500926, 2086703.688963, 2110033.182763, 2111190.300888, 2113731.271005, 2120670.840263, _
   
8. 2123973.309063, 2125068.997336, 2136026.312633, 2156099.495538, 2159021.324663, 2162308.575254, 2178485.706538, 2178759.662849, _
   
9. 2185334.0208, 2187525.481425, 2188621.191481, 2321919.49)
   
10. 
    
11. brr1 = Array( _
    
12. 15.218425, 15.21874996, 15.218750011, 15.218749978, 15.218620279, 15.218612292, 15.218449176, 15.218425, _
    
13. 15.218466998, 15.218524844, 15.218533526, 15.218513908, 15.218530782, 15.218535181, 15.218526248, 15.218519654, _
    
14. 15.218425, 15.218515221, 15.218530782, 15.218523776, 15.218425, 15.218425, 15.218515671, 15.218425, _
    
15. 15.218425, 15.218477932, 15.218472436, 15.218425, 15.218425, 15.218461742, 15.218425, 15.218445786, _
    
16. 15.218425, 15.218425, 15.218437484)
    
17. End Sub
    
18. Sub testb()
    
19. '“朔”直线拟合参数
    
20. arr2 = Array(1457698.231017, 1546082.512234, 1640640.7353, 1642472.151543, 1683430.5093, 1752148.041079, _
    
21.              1807665.420323, 1883618.1141, 1907360.7047, 1936596.2249, 1939135.6753, 1947168#)
    
22. 
    
23. brr2 = Array(29.53067166, 29.53085106, 29.5306, 29.53085439, 29.53086148, _
    
24.              29.53085097, 29.53059851, 29.5306, 29.5306, 29.5306, 29.5306)
    
25. End Sub
    
26. 
    
27. 
    
28. Function getjq_24old(jd2)
    
29. Call testa
    
30. If jd2 >= arr1(UBound(arr1)) Or jd2 < arr1(0) Then getjq_24old = jd2: Exit Function
    
31. 
    
32. For i = 0 To UBound(arr1)
    
33.     If jd2 >= arr1(i) And jd2 < arr1(i + 1) Then
    
34.        k2 = Int((arr1(i + 1) - arr1(i)) / brr1(i))
    
35.        For j = 0 To k2
    
36.            If Abs(arr1(i) + j * brr1(i) - jd2) < 4 Then getjq_24old = arr1(i) + j * brr1(i): Exit Function
    
37.        Next
    
38.     End If
    
39. Next
    
40. End Function
    
41. 
    
42. Function getjq_12old(jd2)
    
43. Call testb
    
44. If jd2 >= arr2(UBound(arr2)) Or jd2 < arr2(0) Then getjq_12old = jd2: Exit Function
    
45. 
    
46. For i = 0 To UBound(arr2)
    
47.     If jd2 >= arr2(i) And jd2 < arr2(i + 1) Then
    
48.        k2 = Int((arr2(i + 1) - arr2(i)) / brr2(i))
    
49.        For j = 0 To k2
    
50.            If Abs(arr2(i) + j * brr2(i) - jd2) < 4 Then getjq_12old = arr2(i) + j * brr2(i): Exit Function
    
51.        Next
    
52.     End If
    
53. Next
    
54. End Function

复制代码

更新版本V3.0 ，成品 下载在1楼。

zopey

zopey 发表于 2019-3-15 16:30
更新版本V3.0 ，成品 下载在1楼。

公元237 年附近，计算“平气”的  自定义函数 getjq_24old 出错， 原因不明。

cyfx2288

zopey 发表于 2019-3-15 22:55
公元237 年附近，计算“平气”的  自定义函数 getjq_24old 出错， 原因不明。

收到，非常感谢。最近有点忙，容出时间，我会核对。

zopey

zopey 发表于 2019-3-15 22:55
公元237 年附近，计算“平气”的  自定义函数 getjq_24old 出错， 原因不明。

1. Function getjq_24old(jd1)
   
2. Call testa
   
3. If jd1 > arr1(UBound(arr1)) + 5 Or jd1 < arr1(0) - 5 Then getjq_24old = jd1: Exit Function
   
4. 
   
5. For i = 0 To UBound(arr1) - 1
   
6.     If Abs(arr1(i) - jd1) < 5 Then getjq_24old = arr1(i): Exit Function
   
7.     If jd1 >= arr1(i) And jd1 < arr1(i + 1) Then
   
8.        If Abs(arr1(i + 1) - jd1) < 5 Then getjq_24old = arr1(i + 1): Exit Function
   
9.       
   
10.        k1 = Int((jd1 - arr1(i)) / brr1(i))
    
11.        For j = k1 To k1 + 1
    
12.            If Abs(arr1(i) + j * brr1(i) - jd1) < 5 Then getjq_24old = arr1(i) + j * brr1(i)
    
13.        Next
    
14.        Exit Function
    
15.     End If
    
16. Next
    
17. End Function
    

复制代码

1. Function getjq_12old(jd2)
   
2. Call testb
   
3. If jd2 > arr2(UBound(arr2)) + 5 Or jd2 < arr2(0) - 5 Then getjq_12old = jd2: Exit Function
   
4. 
   
5. For i = 0 To UBound(arr2) - 1
   
6.     If Abs(arr2(i) - jd2) < 5 Then getjq_12old = arr2(i): Exit Function
   
7.     If jd2 >= arr2(i) And jd2 < arr2(i + 1) Then
   
8.        If Abs(arr2(i + 1) - jd2) < 5 Then getjq_12old = arr2(i + 1): Exit Function
   
9.       
   
10.        k2 = Int((jd2 - arr2(i)) / brr2(i))
    
11.        For j = k2 To k2 + 1
    
12.            If Abs(arr2(i) + j * brr2(i) - jd2) < 5 Then getjq_12old = arr2(i) + j * brr2(i)
    
13.        Next
    
14.        Exit Function
    
15.     End If
    
16. Next
    
17. End Function

复制代码

zopey

格里历日期与儒略历日期的差距

* 1582年——1699年：格里历日期减10日等于儒略历日期。
* 1700年（格里历没有闰日，但儒略历有）：
o 格里历2月28日，合儒略历2月18日，或之前的日期：格里历日期减10日等于儒略历日期。
o 格里历3月1日，合儒略历2月19日，或之后的日期：格里历日期减11日等于儒略历日期。
* 1701年——1799年：格里历日期减11日等于儒略历日期。
* 1800年（格里历没有闰日，但儒略历有）：
o 格里历2月28日，合儒略历2月17日，或之前的日期：格里历日期减11日等于儒略历日期。
o 格里历3月1日，合儒略历2月18日，或之后的日期：格里历日期减12日等于儒略历日期。

* 1801年——1899年：格里历日期减12日等于儒略历日期。
* 1900年（格里历没有闰日，但儒略历有）：
o 格里历2月28日，合儒略历2月16日，或之前的日期：格里历日期减12日等于儒略历日期。
o 格里历3月1日，合儒略历2月17日，或之后的日期：格里历日期减13日等于儒略历日期。

* 1901年——2099年：格里历日期减13日等于儒略历日期。

zopey

公历的一些约定
一、对于公元1582年以后的日期，都用格里历表达，这毫无问题。       但在1582年至20世纪初这三百多年间，许多历史事件就会有两个日期——比如牛顿的生日就有1642年12月25日（儒略历）和1643年1月4日（格里历）两种表达，“十月革命”则有1917年10月25日（儒略历）和1917年11月7日（格里历）两个日期。
二、对于从公元前46年（儒略历开始使用）到公元1582年，这一千六百多年中的日期，当然使用儒略历来表达，因为那时格里历还不存在。
三、国际历史学界和天文学界约定，将公元前46年之前的日期统一用儒略历来表达。历史事件，比如武王伐纣的牧野之战发生于公元前1044年1月9日，或孔子诞生于公元前552年10月9日，这些日期都是儒略历的日期。

fhdyl

感谢楼主分享

jinhaitiao16

楼主，做的还是很不错的

景然

这是一篇农历历法专家级的帖子，建议EH收藏进知识树中

大猫不吃鱼

楼主厉害了