Private Sub CommandButton1_Click()
Dim A As Date, i As Integer, jy As Integer, jm As Integer
Rows("5:65535").ClearContents
T = Array("甲", "乙", "丙", "丁", "戊", "己", "庚", "辛", "壬", "癸")
Dz = Array("子", "丑", "寅", "卯", "辰", "巳", "午", "未", "申", "酉", "戌", "亥")
'F = Array("小寒", "立春", "惊蛰", "清明", "立夏", "芒种", "小暑", "立秋", "白露", "寒露", "立冬", "大雪")
F = Array("小寒", "大寒", "立春", "雨水", "惊蛰", "春分", "清明", "谷雨", "立夏", "小满", "芒种", "夏至", "小暑", "大暑", "立秋", "处暑", "白露", "秋分", "寒露", "霜降", "立冬", "小雪", "大雪", "冬至")
'四柱
A = Cells(1, 4).Value
Cells(3, 4).Value = sizhu(A)
'阴阳与顺逆
B = Left(sizhu(A), 1)
For i = 0 To 9
If T(i) = B Then
If i Mod 2 = 0 Then
Cells(3, 2).Value = "阳年"
If Cells(1, 2).Value = "男" Then Cells(4, 2).Value = "顺": Exit For
Else
Cells(3, 2).Value = "阴年"
If Cells(1, 2).Value = "女" Then Cells(4, 2).Value = "顺": Exit For
End If
Cells(4, 2).Value = "逆": Exit For
End If
Next
'寻找第一个节气
If A < getjq(year(A), 0) Then
If Cells(4, 2).Value = "顺" Then
jy = year(A): jm = 0
ElseIf Cells(4, 2).Value = "逆" Then
jy = year(A) - 1: jm = 22
End If
ElseIf A >= getjq(year(A), 22) Then
If Cells(4, 2).Value = "顺" Then
jy = year(A) + 1: jm = 0
ElseIf Cells(4, 2).Value = "逆" Then
jy = year(A): jm = 22
End If
Else
For i = 0 To 20 Step 2
If A >= getjq(year(A), i) And A < getjq(year(A), i + 2) Then
If Cells(4, 2).Value = "顺" Then
jy = year(A): jm = i + 2
ElseIf Cells(4, 2).Value = "逆" Then
jy = year(A): jm = i
End If
Exit For
End If
Next
End If
jy0 = jy: jm0 = jm
For i = 0 To 9
If T(i) = Mid(sizhu(A), 6, 1) Then k1 = i: Exit For
Next
For i = 0 To 11
If Dz(i) = Mid(sizhu(A), 7, 1) Then k2 = i: Exit For
Next
For i = 0 To 11
If Cells(4, 2).Value = "顺" Then
If k1 = 9 Then k1 = 0 Else k1 = k1 + 1
If k2 = 11 Then k2 = 0 Else k2 = k2 + 1
Cells(i + 5, 6).Value = T(k1) & Dz(k2)
Cells(i + 5, 3).Value = F(jm)
Cells(i + 5, 4).Value = getjq(jy, jm)
d2 = DateDiff("n", A, Cells(i + 5, 4).Value)
d2 = Int(d2 / 12)
sk1 = Int(d2 / 360)
sk2 = Int((d2 - 360 * Int(d2 / 360)) / 30)
sk3 = d2 - 360 * Int(d2 / 360) - 30 * Int((d2 - 360 * Int(d2 / 360)) / 30) - DateDiff("d", A, Cells(5, 4).Value)
If jm0 + sk2 * 2 >= 24 Then sk1 = sk1 + 1: sk2 = sk2 - 12
Cells(i + 5, 7).Value = DateAdd("d", sk3, getjq(jy0 + sk1, jm0 + sk2 * 2))
Cells(i + 5, 5).Value = Int(d2 / 360) & "岁 "
Cells(i + 5, 5).Value = Cells(i + 5, 5).Value & Int((d2 - 360 * Int(d2 / 360)) / 30) & "个月 "
Cells(i + 5, 5).Value = Cells(i + 5, 5).Value & d2 - 360 * Int(d2 / 360) - 30 * Int((d2 - 360 * Int(d2 / 360)) / 30) & "天"
jm = jm + 2
If jm = 24 Then jm = 0: jy = jy + 1
ElseIf Cells(4, 2).Value = "逆" Then
If k1 = 0 Then k1 = 9 Else k1 = k1 - 1
If k2 = 0 Then k2 = 11 Else k2 = k2 - 1
Cells(i + 5, 6).Value = T(k1) & Dz(k2)
Cells(i + 5, 3).Value = F(jm)
Cells(i + 5, 4).Value = getjq(jy, jm)
d1 = DateDiff("n", Cells(i + 5, 4).Value, A)
d1 = Int(d1 / 12)
nk1 = Int(d1 / 360)
nk2 = Int((d1 - 360 * Int(d1 / 360)) / 30)
If jm0 + nk2 * 2 >= 24 Then nk1 = nk1 + 1: nk2 = nk2 - 12
nk3 = d1 - 360 * Int(d1 / 360) - 30 * Int((d1 - 360 * Int(d1 / 360)) / 30) + DateDiff("d", Cells(5, 4).Value, A)
Cells(i + 5, 7).Value = DateAdd("d", nk3, getjq(jy0 + nk1, jm0 + nk2 * 2))
Cells(i + 5, 5).Value = Int(d1 / 360) & "岁 "
Cells(i + 5, 5).Value = Cells(i + 5, 5).Value & Int((d1 - 360 * Int(d1 / 360)) / 30) & "个月 "
Cells(i + 5, 5).Value = Cells(i + 5, 5).Value & d1 - 360 * Int(d1 / 360) - 30 * Int((d1 - 360 * Int(d1 / 360)) / 30) & "天"
jm = jm - 2
If jm = -2 Then jm = 22: jy = jy - 1
End If
Next
End Sub |