易术基础

zopey

易术基础.zip (72.81 KB, 下载次数: 586)

2018-1-23 15:47 上传

点击文件名下载附件

YZC51

谢谢楼主分享！！！

jinhaitiao16

谢谢楼主分享！！！

zopey

起大运 如何精确到天， 尚有疑问：
周岁的年、月、日 是在公历生日基础上 依次增加 ，还是在农历生日上 依次增加呢？

大运流年.zip (41.23 KB, 下载次数: 187)

2018-2-9 15:58 上传

点击文件名下载附件

zopey

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

jinhaitiao16

谢谢楼主分享！

zopey

九宫相关



九宫数.rar (6.39 KB, 下载次数: 133)

2018-3-11 10:24 上传

点击文件名下载附件

nicolagreen

厉害，谢谢分享

拉姆333

哇！好神奇的样子！

605862777

上面的代码复制运行出现错误