儒略日转换小工具

zopey

儒略日(Julian Day)是在儒略周期内以连续的日数计算时间的计时法，主要是天文学家在使用。
起点在公元前4713年(天文学上记为 -4712年)1月1日格林威治时间平午（世界时12:00)。


利用儒略日的概念，可以突破EXCEL 日期格式数据、日期函数的限制，丰富计算内容。



儒略日201811.zip (35.37 KB, 下载次数: 212)

2018-11-8 16:03 上传

点击文件名下载附件

zopey

Function JD2GL(JD As Double) As String
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 = Round(((d2 - hh1 * 3600) / 60), 0)
'ss1 = d2 - hh1 * 3600 - mm1 * 60

If mm1 < 10 Then mm1 = "0" & mm1
If mm1 = 60 Then mm1 = 59

JD2GL = y1 & "-" & m1 & "-" & Int(d1) & " " & hh1 & ":" & mm1
End Function

zopey

这是公历转换儒略日的 计算过程，是 儒略日转换为公历的 互补函数 。

Function GL2JD(Y As Integer, M As Integer, D As Integer) As Double

If M <= 2 Then M = M + 12: Y = Y - 1
A1 = Int(365.25 * Y)
A2 = Int(30.6001 * (M + 1))
B = -2
If Y > 1582 Or (Y = 1582 And (M > 10 Or (M = 10 And D >= 15))) Then
   B = Int(Y / 400) - Int(Y / 100)
End If
GL2JD = (A1 + A2 + B + 1720996.5) + D + 12 / 24#

End Function

zopey

公元前、后交界分析图

zopey

1582年 公历缺10天， 及24节气 分析图 （涂绿 代表干支年范围）

zopey

对sizhu函数代码 小改后，交节时刻的 月干支计算  精确到 分钟。

br1 = Split(birth, " ")
hh = br1(1)
hh2 = DateDiff("n", "12:00", hh) / 1440


If GL2JD(year, mm, dd) + hh2 >= getjq(i, 2) Then
If GL2JD(year, mm, dd) + hh2 >= getjq(temp0, i * 2) Then

zopey

抛砖引玉，把上面的关于儒略日的几个例子，制作成附件 供测试。

儒略日综合应用举例.zip (70.19 KB, 下载次数: 134)

2018-11-9 15:35 上传

点击文件名下载附件

zopey

八字反推代码如下,  红色部分为 修正后代码。（上楼层附件代码有 些许错误， 请自行更新）

Sub test2()
Rows("3:65535").ClearContents

    Dim LSJZ
    tt$ = "甲子 乙丑 丙寅 丁卯 戊辰 已巳 庚午 辛未 壬申 癸酉 甲戌 乙亥 " _
        & "丙子 丁丑 戊寅 已卯 庚辰 辛巳 壬午 癸未 甲申 乙酉 丙戌 丁亥 " _
        & "戊子 已丑 庚寅 辛卯 壬辰 癸巳 甲午 乙未 丙申 丁酉 戊戌 已亥 " _
        & "庚子 辛丑 壬寅 癸卯 甲辰 乙巳 丙午 丁未 戊申 已酉 庚戌 辛亥 " _
        & "壬子 癸丑 甲寅 乙卯 丙辰 丁巳 戊午 已未 庚申 辛酉 壬戌 癸亥"
    LSJZ = Split(tt)

Dim i As Long, lichun As String, jieqi As String

bazi = [B1]
yy1 = Left([B1], 2)
yz2 = Mid([B1], 5, 2)
rz3 = Mid([B1], 9, 2)
hh = DateDiff("n", "12:00", [a1]) / 1440

Dim k1 As Long
For i = 0 To 59
   If LSJZ(i) = yy1 Then k1 = i + 4: k3 = k3 + 1

   If LSJZ(i) = yz2 Then k2 = (i - 1) Mod 12: k3 = k3 + 1
   If k2 < 0 Then k2 = k2 + 12
  
   If k3 = 2 Then Exit For
Next

''''''''''''
k4 = 2
Dim j As Double
For i = k1 To 2200 Step 60
    jieqi1 = Int(getjq(i, k2 * 2)) - 2
    jieqi2 = Int(getjq(i, (k2 + 1) * 2)) + 2

      For j = jieqi1 To jieqi2
          If sizhu(JD2GL(j + hh)) = bazi Then
             k4 = k4 + 1
             Cells(k4, 1) = JD2GL(j + hh)
             Cells(k4, 2) = sizhu(JD2GL(j + hh))
             Exit For
          End If
      Next j
Next i
End Sub

zopey

儒略日 应用于排列 当月日历 （按年周数+ 星期）

Function week2Day(yy As Integer, i As Integer, k As Integer, mm As Integer) As String
    Dim date1 As Long, date2 As Long, date3 As Long, j As Integer
    If i <= 0 Or i > 53 Then Exit Function
    If mm < 0 Or m > 12 Then Exit Function
   
    date1 = GL2JD(yy, 1, 1)
    j = date1 Mod 7 + 1
    j = (8 - j) + (i - 2) * 7
    date1 = date1 + (j + k - 1)
   
    If mm > 0 Then
       date2 = GL2JD(yy, mm, 1)
       date3 = GL2JD(yy, mm + 1, 1)
       If date1 >= date2 And date1 < date3 Then
          If date1 > 2299160 And date1 <= 2299177 Then
             week2Day = date1 - date2 + 11
          Else
             week2Day = date1 - date2 + 1
          End If
       End If
    Else
       week2Day = date1
    End If
End Function

推算当月日期.rar (17.32 KB, 下载次数: 114)

2018-11-12 18:48 上传

点击文件名下载附件

YZC51

楼主太强大啦！谢谢分享！
白玉微瑕！