Private Sub CommandButton1_Click()
Dim A As Date, i As Integer
Rows("9: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
'填写节气
C = Mid(sizhu(A), 8, 2)
If A < getjq(year(A), 0) Then
Cells(4, 3).Value = F(22)
Cells(4, 4).Value = getjq(year(A) - 1, 22)
Cells(5, 3).Value = F(0)
Cells(5, 4).Value = getjq(year(A), 0)
ElseIf A >= getjq(year(A), 22) Then
Cells(4, 3).Value = F(22)
Cells(4, 4).Value = getjq(year(A), 22)
Cells(5, 3).Value = F(0)
Cells(5, 4).Value = getjq(year(A) + 1, 0)
Else
For i = 0 To 20 Step 2
If A >= getjq(year(A), i) And A < getjq(year(A), i + 2) Then
Cells(4, 3).Value = F(i)
Cells(4, 4).Value = getjq(year(A), i)
Cells(5, 3).Value = F(i + 2)
Cells(5, 4).Value = getjq(year(A), i + 2)
Exit For
End If
Next
End If
'起运天数
If Cells(4, 2).Value = "顺" Then
D = DateDiff("n", A, Cells(5, 4).Value)
Else
D = DateDiff("n", Cells(4, 4).Value, A)
End If
Cells(5, 2).Value = Int(D / 12)
dd = Application.Round(Int(D / (12 * 360)), 0)
'大运与流年
Cells(9, 5).Value = Mid(sizhu(A), 6, 2)
Cells(9, 4).Value = A
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
kk = 0
For i = 0 To 100
Cells(i + 9, 1).Value = i
Cells(i + 9, 2).Value = year(A) + i
Cells(i + 9, 3).Value = Left(sizhu(year(A) + i & "-7-7"), 2)
If i = dd Then
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 + 9, 5).Value = T(k1) & Dz(k2)
Else
If k1 = 0 Then k1 = 9 Else k1 = k1 - 1
If k2 = 0 Then k2 = 11 Else k2 = k2 - 1
Cells(i + 9, 5).Value = T(k1) & Dz(k2)
End If
Cells(i + 9, 4).Value = DateAdd("yyyy", kk, DateAdd("d", Int(D * 365.42 / (12 * 360)), A))
dd = dd + 10
kk = kk + 10
End If
Next
End Sub
