24节气

chuhaiou · 发表于 2020-3-7 17:37

网上找的程序，不知什么原因只能提前预告节气，而当天不显示
Private Function JieQi(TempDate As String) As String '计算节气
Dim S_Term(1 To 24) As String
Dim StInfo(1 To 24) As Long
Dim y As Integer, j As Integer, k As Integer
Dim E(1)  As Double
Dim dtJ As Date
Dim strJm As String, strJd As String
Dim Strj As String  '节气日期    '节气名
S_Term(1) = "小寒"
S_Term(2) = "大寒"
S_Term(3) = "立春"
S_Term(4) = "雨水"
S_Term(5) = "惊蛰"
S_Term(6) = "春分"
S_Term(7) = "清明"
  S_Term(8) = "谷雨"
S_Term(9) = "立夏"
S_Term(10) = "小满"
  S_Term(11) = "芒种"
S_Term(12) = "夏至"
S_Term(13) = "小暑"
S_Term(14) = "大署"
S_Term(15) = "立秋"
S_Term(16) = "处暑"
S_Term(17) = "白露"
S_Term(18) = "秋分"
  S_Term(19) = "寒露"
S_Term(20) = "霜降"
S_Term(21) = "立冬"
S_Term(22) = "小雪"
S_Term(23) = "大雪"
S_Term(24) = "冬至"             '节气信息
StInfo(1) = 0
StInfo(2) = 21208
StInfo(3) = 42467
StInfo(4) = 63836
StInfo(5) = 85337
StInfo(6) = 107014
StInfo(7) = 128867
  StInfo(8) = 150921
StInfo(9) = 173149
StInfo(10) = 195551
StInfo(11) = 218072
StInfo(12) = 240693
StInfo(13) = 263343
StInfo(14) = 285989
StInfo(15) = 308563
StInfo(16) = 331033
StInfo(17) = 353350
StInfo(18) = 375494
StInfo(19) = 397447
StInfo(20) = 419210
StInfo(21) = 440795
StInfo(22) = 462224
StInfo(23) = 483532
StInfo(24) = 504758
  y = Val(Left(TempDate, 4)): j = Val(Mid(TempDate, 6, 2)): k = Val(Right(TempDate, 2))
  If k <= 15 Then
  j = j * 2 - 1
  Else
  j = j * 2
End If
E(0) = (31556925.9747 * (y - 1900) + StInfo(j) * 60#)
E(1) = DateDiff("s", "1970-1-1 0:0", "1900-1-6 2:5") + E(0)
E(0) = E(1) / 2
dtJ = DateAdd("s", E(1) - E(0), DateAdd("s", E(0), "1970-1-1 1:18"))
dtJ = Year(dtJ) & "-" & Month(dtJ) & "-" & Day(dtJ)
If (Month(dtJ) < 10) Then
strJm = "0" & Month(dtJ)
Else
strJm = Month(dtJ)
End If
If (Day(dtJ) < 10) Then
strJd = "0" & Day(dtJ)
Else
strJd = Day(dtJ)
End If
Strj = Format(Year(dtJ) & "-" & strJm & "-" & strJd, "yyyy-mm-dd")
JieQi = ""
If DateDiff("d", Strj, TempDate) = -2 Then JieQi = "后天" + S_Term(j)
If DateDiff("d", Strj, TempDate) = -1 Then JieQi = "明天" + S_Term(j)
If Strj = TempDate Then JieQi = "今天" + S_Term(j)
End Function
Sub 二十四节气()
MsgBox JieQi(Date)
End Sub

zopey · 发表于 2020-3-7 20:17

类似公式

http://club.excelhome.net/thread-1390487-1-1.html

chuhaiou · 发表于 2020-3-7 22:27

zopey 发表于 2020-3-7 20:17
类似公式

http://club.excelhome.net/thread-1390487-1-1.html

谢谢！我不是在EXCEL中用，不会调用那函数。

chuhaiou · 发表于 2020-3-7 22:31

本帖最后由 chuhaiou 于 2020-3-7 23:26 编辑

chuhaiou 发表于 2020-3-7 22:27
谢谢！我不是在EXCEL中用，不会调用那函数。

If DateDiff("d", Strj, TempDate) = 0 JieQi = "今天" + S_Term(j)

YZC51 · 发表于 2020-3-8 04:51

试试
If CDate(Strj) = TempDate Then JieQi = "今天" + S_Term(j)

YZC51 · 发表于 2020-3-8 08:36

请参考
'网上找的程序，不知什么原因只能提前预告节气，而当天不显示
Private Function JieQi(TempDate As String) ' As String '计算节气
Dim S_Term(1 To 24) As String
Dim StInfo(1 To 24) As Long
Dim y As Integer, j As Integer, k As Integer
Dim E(1)  As Double
Dim dtJ As Date
Dim strJm As String, strJd As String
Dim Strj As String  '节气日期    '节气名
S_Term(1) = "小寒"
S_Term(2) = "大寒"
S_Term(3) = "立春"
S_Term(4) = "雨水"
S_Term(5) = "惊蛰"
S_Term(6) = "春分"
S_Term(7) = "清明"
  S_Term(8) = "谷雨"
S_Term(9) = "立夏"
S_Term(10) = "小满"
  S_Term(11) = "芒种"
S_Term(12) = "夏至"
S_Term(13) = "小暑"
S_Term(14) = "大署"
S_Term(15) = "立秋"
S_Term(16) = "处暑"
S_Term(17) = "白露"
S_Term(18) = "秋分"
  S_Term(19) = "寒露"
S_Term(20) = "霜降"
S_Term(21) = "立冬"
S_Term(22) = "小雪"
S_Term(23) = "大雪"
S_Term(24) = "冬至"             '节气信息
StInfo(1) = 0
StInfo(2) = 21208
StInfo(3) = 42467
StInfo(4) = 63836
StInfo(5) = 85337
StInfo(6) = 107014
StInfo(7) = 128867
  StInfo(8) = 150921
StInfo(9) = 173149
StInfo(10) = 195551
StInfo(11) = 218072
StInfo(12) = 240693
StInfo(13) = 263343
StInfo(14) = 285989
StInfo(15) = 308563
StInfo(16) = 331033
StInfo(17) = 353350
StInfo(18) = 375494
StInfo(19) = 397447
StInfo(20) = 419210
StInfo(21) = 440795
StInfo(22) = 462224
StInfo(23) = 483532
StInfo(24) = 504758
  y = Val(Left(TempDate, 4)): j = Val(Mid(TempDate, 6, 2)): k = Val(Right(TempDate, 2))
  If k <= 15 Then
  j = j * 2 - 1
  Else
  j = j * 2
End If
E(0) = (31556925.9747 * (y - 1900) + StInfo(j) * 60#)
E(1) = DateDiff("s", "1970-1-1 0:0", "1900-1-6 2:5") + E(0)
E(0) = E(1) / 2
dtJ = DateAdd("s", E(1) - E(0), DateAdd("s", E(0), "1970-1-1 1:18"))
dtJ = Year(dtJ) & "-" & Month(dtJ) & "-" & Day(dtJ)
If (Month(dtJ) < 10) Then
strJm = "0" & Month(dtJ)
Else
strJm = Month(dtJ)
End If
If (Day(dtJ) < 10) Then
strJd = "0" & Day(dtJ)
Else
strJd = Day(dtJ)
End If
Strj = Format(Year(dtJ) & "-" & strJm & "-" & strJd, "yyyy-mm-dd")
JieQi = ""
If DateDiff("d", Strj, TempDate) > -2 Then JieQi = 14 - DateDiff("d", Strj, TempDate) & "天后" + S_Term(j + 1)
If DateDiff("d", Strj, TempDate) = -2 Then JieQi = "后天" + S_Term(j)
If DateDiff("d", Strj, TempDate) = -1 Then JieQi = "明天" + S_Term(j)
If CDate(Strj) = TempDate Then JieQi = "今天" + S_Term(j)
End Function

Sub 二十四节气()
MsgBox JieQi(Date)
MsgBox JieQi("2020-3-4")
MsgBox JieQi("2020-3-5")
End Sub

chuhaiou · 发表于 2020-3-8 13:06

YZC51 发表于 2020-3-8 08:36
请参考
'网上找的程序，不知什么原因只能提前预告节气，而当天不显示
Private Function JieQi(TempDate A ...

谢谢帮助！还是有极少量相差一天。如本应2022年3月20日春分，本程序是3月21日春分。

YZC51 · 发表于 2020-3-8 14:12

chuhaiou 发表于 2020-3-8 13:06
谢谢帮助！还是有极少量相差一天。如本应2022年3月20日春分，本程序是3月21日春分。

要想精确，只能用2楼老师的天文算法！

renkangjizhen · 发表于 2020-3-8 15:04

把24节气名用数组表示，节与结之间有固定值，设好一个值，其余用代码自算即可，能大量简化代码

chuhaiou · 发表于 2020-3-8 21:37

YZC51 发表于 2020-3-8 14:12
要想精确，只能用2楼老师的天文算法！

那个算法，离开电子表格，我引用不来。好像与单元格有关系。

		自动登录	找回密码
密码			免费注册

[分享] 24节气

评分

最新热点 /1