slore
铂金会员
积分 5212
发帖 2478
注册 2007-2-8
状态 离线
|
『第
2 楼』:
下面是VB的一段，你自己看看算法，改成VBS版本的吧。
上学去了……
Option Explicit
Dim SolarTerm(1 To 24) As String '阳历的节气
Dim sTermInfo(1 To 24) As Double '阳历节气的信息码
Public Sub SetValue()
Dim i As Integer
Dim StrST As String, StrSTI As String
StrST = "小寒大寒立春雨水惊蛰春分清明谷雨立夏小满芒种夏至小暑大暑立秋处暑白露秋分寒露霜降立冬小雪大雪冬至"
StrSTI = "000000,021208,042467,063836,085337,107014,128867,150921,173149,195551,218072,240693,263343,285989,308563,331033,353350,375494,397447,419210,440795,462224,483532,504758"
For i = 1 To 24
SolarTerm(i) = Mid(StrST, (i - 1) * 2 + 1, 2)
sTermInfo(i) = Val(Mid(StrSTI, (i - 1) * 7 + 1, 6))
Next i
End Sub
'某y年的第n个节气的日期(从1小寒起算)
Function sTerm(ByVal Y, n As Integer) As Date
Dim D1, D2 As Double
D1 = (31556925.9747 * (Y - 1900) + sTermInfo(n) * 60#)
D2 = DateDiff("s", "1970-1-1 0:0", "1900-1-6 2:5") + D1
D1 = D2 / 2
sTerm = DateAdd("s", D2 - D1, DateAdd("s", D1, "1970-1-1 0:0"))
sTerm = Format(sTerm, "yyyy/mm/dd")
End Function
'根据阳历返回其节气，若不是则返回空
Public Function GetTerm(ByVal sDate As Date) As String
Dim Y, m As Integer
Y = Year(sDate)
m = Month(sDate)
GetTerm = " "
If sTerm(Y, m * 2 - 1) = sDate Then
GetTerm = SolarTerm(m * 2 - 1)
ElseIf sTerm(Y, m * 2) = sDate Then
GetTerm = SolarTerm(m * 2)
End If
End Function
Private Sub Command1_Click()
Call SetValue
Print GetTerm(#12/7/2007#)
End Sub
|
|
