Đây là module 2 + 4 đã chỉnh sửa hàm Tietkhi cho phép tính toán đến tận giờ phút giây. Tuy nhiên vẫn chưa phải là hàm để dùng trong Kỳ Môn (Vụ này để khí nào hỏi được thầy chi tiết đã, chứ tính Siêu Thần Tiếp Khí theo mốc năm nào thì chưa đọc ra)
Tietkhi(i) trả về giá trị thứ tự tiết khí hoặc tên. VD: Tietkhi(1) = "Đông chí" hay Tietkhi("Đông chí") = 1
Tietkhi(i,j) trả về giá trị ngày giờ bắt đầu của tiết khí i trong năm j
Tietkhi(i,"TRUE") trả về giá trị ngày giờ i (theo Excel) là thuộc tiết khí nào
------------------
Option Explicit
Private Function jdFromDate(ByVal dd As Integer, ByVal mm As Integer, ByVal yy As Integer, Optional ByVal hr As Integer = 0, _
Optional ByVal min As Integer = 0, Optional sec As Integer = 0, Optional Timezone As Integer = 7) As Double
Dim a, y, m, jd
a = Int((14 - mm) / 12)
y = yy + 4800 - a
m = mm + 12 * a - 3
jd = dd + Int((153 * m + 2) / 5) + 365 * y + Int(y / 4) - Int(y / 100) + Int(y / 400) - 32045
If (jd < 2299161) Then jd = dd + Int((153 * m + 2) / 5) + 365 * y + Int(y / 4) - 32083 - (Timezone / 24)
If hr > 0 Or min > 0 Or sec > 0 Then jd = jd + (hr - 12) / 24 + min / 1440 + sec / 86400
jdFromDate = jd
End Function
Private Function jdToDate(ByVal jd As Double) As Double
Dim a, b, c, D, e, m, day, month, year, hr, min, sec
If (jd > 2299160) Then
a = jd + 32044
b = Int((4 * a + 3) / 146097)
c = a - Int((b * 146097) / 4)
Else
b = 0
c = jd + 32082
End If
D = Int((4 * c + 3) / 1461)
e = c - Int((1461 * D) / 4)
m = Int((5 * e + 2) / 153)
day = e - Int((153 * m + 2) / 5) + 1
month = m + 3 - 12 * Int(m / 10)
year = b * 100 + D - 4800 + Int(m / 10)
'jdToDate = day & "/" & month & "/" & year
jdToDate = DateFrom(day, month, year) + jd - Int(jd)
End Function
Private Function getNewMoonDay(ByVal k As Integer, Optional ByVal Timezone As Integer = 7) As Long ' Tinh ngay soc
Dim T, T2, T3, dr, Jd1, m, Mpr, F, C1, deltat, JdNew
T = k / 1236.85 '' Time in Julian centuries from 1900 January 0.5
T2 = T * T
T3 = T2 * T
dr = WorksheetFunction.Pi / 180
Jd1 = 2415020.75933 + 29.53058868 * k + 0.0001178 * T2 - 0.000000155 * T3
Jd1 = Jd1 + 0.00033 * Sin((166.56 + 132.87 * T - 0.009173 * T2) * dr) ' Mean new moon
m = 359.2242 + 29.10535608 * k - 0.0000333 * T2 - 0.00000347 * T3 ' Sun's mean anomaly
Mpr = 306.0253 + 385.81691806 * k + 0.0107306 * T2 + 0.00001236 * T3 ' Moon's mean anomaly
F = 21.2964 + 390.67050646 * k - 0.0016528 * T2 - 0.00000239 * T3 ' Moon's argument of latitude
C1 = (0.1734 - 0.000393 * T) * Sin(m * dr) + 0.0021 * Sin(2 * dr * m)
C1 = C1 - 0.4068 * Sin(Mpr * dr) + 0.0161 * Sin(dr * 2 * Mpr)
C1 = C1 - 0.0004 * Sin(dr * 3 * Mpr)
C1 = C1 + 0.0104 * Sin(dr * 2 * F) - 0.0051 * Sin(dr * (m + Mpr))
C1 = C1 - 0.0074 * Sin(dr * (m - Mpr)) + 0.0004 * Sin(dr * (2 * F + m))
C1 = C1 - 0.0004 * Sin(dr * (2 * F - m)) - 0.0006 * Sin(dr * (2 * F + Mpr))
C1 = C1 + 0.001 * Sin(dr * (2 * F - Mpr)) + 0.0005 * Sin(dr * (2 * Mpr + m))
If (T < -11) Then
deltat = 0.001 + 0.000839 * T + 0.0002261 * T2 - 0.00000845 * T3 - 0.000000081 * T * T3
Else
deltat = -0.000278 + 0.000265 * T + 0.000262 * T2
End If
JdNew = Jd1 + C1 - deltat
getNewMoonDay = Int(JdNew + 0.5 + Timezone / 24)
End Function
Private Function getSunLongitude(ByVal jdn As Double, ByVal Timezone As Integer, Optional ByVal Exactly As Boolean = False) As Double
Dim T, T2, dr, m, L0, DL, l
T = (jdn - 2451545.5 - Timezone / 24) / 36525 ' Time in Julian centuries from 2000-01-01 12:00:00 GMT
If Exactly Then T = T + 0.5 / 36525
T2 = T * T
dr = WorksheetFunction.Pi / 180 ' degree to radian
m = 357.5291 + 35999.0503 * T - 0.0001559 * T2 - 0.00000048 * T * T2 ' mean anomaly, degree
L0 = 280.46645 + 36000.76983 * T + 0.0003032 * T2 ' mean longitude, degree
DL = (1.9146 - 0.004817 * T - 0.000014 * T2) * Sin(dr * m)
DL = DL + (0.019993 - 0.000101 * T) * Sin(dr * 2 * m) + 0.00029 * Sin(dr * 3 * m)
l = L0 + DL ' true longitude, degree
If Exactly Then
l = l - 0.00569 - 0.00478 * Sin(125.04 * dr - 1934.136 * T * dr)
l = l - 360 * Int(l / 360)
getSunLongitude = l
Else
l = l * dr
l = l - WorksheetFunction.Pi * 2 * (Int(l / (WorksheetFunction.Pi * 2))) ' Normalize to (0, 2*PI)
getSunLongitude = Int(l / WorksheetFunction.Pi * 6)
End If
End Function
Private Function getLunarMonth11(ByVal yy As Integer, Optional ByVal Timezone As Integer = 7) As Long
Dim k, off, nm, sunLong
off = jdFromDate(31, 12, yy) - 2415021
k = Int(off / 29.530588853)
nm = getNewMoonDay(k, Timezone)
sunLong = getSunLongitude(nm, Timezone) ' sun longitude at local midnight
If (sunLong >= 9) Then nm = getNewMoonDay(k - 1, Timezone)
getLunarMonth11 = nm
End Function
Private Function getLeapMonthOffset(ByVal a11 As Long, Optional ByVal Timezone As Integer = 7) As Integer
Dim k, last, Arc, i
k = Int((a11 - 2415021.07699869) / 29.530588853 + 0.5)
last = 0
i = 1 ' We start with the month following lunar month 11
Arc = getSunLongitude(getNewMoonDay(k + i, Timezone), Timezone)
Do While (Arc <> last And i < 14)
last = Arc
i = i + 1
Arc = getSunLongitude(getNewMoonDay(k + i, Timezone), Timezone)
Loop
getLeapMonthOffset = i - 1
End Function
Public Function ChuyenAL(ByVal dd As Integer, ByVal mm As Integer, ByVal yy As Integer, Optional ByVal Timezone As Integer = 7) As Double
Dim k, dayNumber, monthStart, a11, b11, lunarLeap, diff, leapMonthDiff
Dim lunarDay As Integer, lunarMonth As Integer, lunarYear As Integer
dayNumber = jdFromDate(dd, mm, yy)
k = Int((dayNumber - 2415021.07699869) / 29.530588853)
monthStart = getNewMoonDay(k + 1, Timezone)
If (monthStart > dayNumber) Then monthStart = getNewMoonDay(k, Timezone)
a11 = getLunarMonth11(yy, Timezone)
b11 = a11
If (a11 >= monthStart) Then
lunarYear = yy
a11 = getLunarMonth11(yy - 1, Timezone)
Else
lunarYear = yy + 1
b11 = getLunarMonth11(yy + 1, Timezone)
End If
lunarDay = dayNumber - monthStart + 1
diff = Int((monthStart - a11) / 29)
lunarLeap = 0
lunarMonth = diff + 11
If (b11 - a11 > 365) Then
leapMonthDiff = getLeapMonthOffset(a11, Timezone)
If (diff >= leapMonthDiff) Then
lunarMonth = diff + 10
If (diff = leapMonthDiff) Then lunarLeap = 1
End If
End If
If (lunarMonth > 12) Then lunarMonth = lunarMonth - 12
If (lunarMonth >= 11 And diff < 4) Then lunarYear = lunarYear - 1
'If lunarLeap = 0 Then
' ChuyenAL = DateFrom(lunarDay, lunarMonth, lunarYear)
'Else
' ChuyenAL = lunarDay & "/" & lunarMonth & "n/" & lunarYear
'End If
ChuyenAL = DateFrom(lunarDay, lunarMonth, lunarYear)
End Function
Public Function ChuyenDL(ByVal lunarDay As Integer, ByVal lunarMonth As Integer, ByVal lunarYear As Integer, _
Optional ByVal lunarLeap As Integer = 0, Optional ByVal Timezone As Integer = 7) As Double
Dim k, a11, b11, off, leapOff, leapMonth, monthStart
If (lunarMonth < 11) Then
a11 = getLunarMonth11(lunarYear - 1, Timezone)
b11 = getLunarMonth11(lunarYear, Timezone)
Else
a11 = getLunarMonth11(lunarYear, Timezone)
b11 = getLunarMonth11(lunarYear + 1, Timezone)
End If
off = lunarMonth - 11
If (off < 0) Then off = off + 12
If (b11 - a11 > 365) Then
leapOff = getLeapMonthOffset(a11, Timezone)
leapMonth = leapOff - 2
If (leapMonth < 0) Then leapMonth = leapMonth + 12
If (lunarLeap <> 0 And lunarMonth <> leapMonth) Then
ChuyenDL = 0
Else
If (lunarLeap <> 0 Or off >= leapOff) Then off = off + 1
End If
End If
k = Int(0.5 + (a11 - 2415021.07699869) / 29.530588853)
monthStart = getNewMoonDay(k + off, Timezone)
ChuyenDL = jdToDate(monthStart + lunarDay - 1)
End Function
Public Function ThangNhuan(ByVal dd As Integer, ByVal mm As Integer, ByVal yy As Integer, Optional ByVal Timezone As Integer = 7) As Boolean
Dim k, dayNumber, monthStart, a11, b11, lunarLeap, diff, leapMonthDiff
Dim lunarDay As Integer, lunarMonth As Integer, lunarYear As Integer
dayNumber = jdFromDate(dd, mm, yy)
k = Int((dayNumber - 2415021.07699869) / 29.530588853)
monthStart = getNewMoonDay(k + 1, Timezone)
If (monthStart > dayNumber) Then monthStart = getNewMoonDay(k, Timezone)
a11 = getLunarMonth11(yy, Timezone)
b11 = a11
If (a11 >= monthStart) Then
lunarYear = yy
a11 = getLunarMonth11(yy - 1, Timezone)
Else
lunarYear = yy + 1
b11 = getLunarMonth11(yy + 1, Timezone)
End If
diff = Int((monthStart - a11) / 29)
lunarLeap = 0
lunarMonth = diff + 11
If (b11 - a11 > 365) Then
leapMonthDiff = getLeapMonthOffset(a11, Timezone)
If (diff >= leapMonthDiff) Then
lunarMonth = diff + 10
If (diff = leapMonthDiff) Then lunarLeap = 1
End If
End If
ThangNhuan = (lunarLeap = 1)
End Function
Public Function TietKhi(ByVal i As Variant, Optional j As Variant = "FALSE", Optional Timezone As Integer = 7) As Variant
' Ham tra ve Ten Tiet Khi hoac STT tiet khi tinh tu Dong Chi, neu co tham so thu 2 thi se tra ve thoi diem bat dau cua tiet khi trong nam j
' Neu tham so thu 2 = "TRUE" thi se tinh xem ngay gio i nam trong tiet khi nao
Dim Str As String
Dim Num, TK, TD As Integer
Dim Ngaytim, Ngay1, Ngay2 As Double
Dim D As Double
Select Case i
Case 1: Str = "Ddoong chis"
Case 2: Str = "Tieeru hafn"
Case 3: Str = "Ddaji hafn"
Case 4: Str = "Laajp xuaan"
Case 5: Str = "Vux thuyr"
Case 6: Str = "Kinh chaajp"
Case 7: Str = "Xuaan phaan"
Case 8: Str = "Thanh Minh"
Case 9: Str = "Coosc vux"
Case 10: Str = "Laajp haj"
Case 11: Str = "Tieeru maxn"
Case 12: Str = "Mang churng"
Case 13: Str = "Haj chis"
Case 14: Str = "Tieeru thuwr"
Case 15: Str = "Ddaji thuwr"
Case 16: Str = "Laajp thu"
Case 17: Str = "Suwr thuwr"
Case 18: Str = "Bajch looj"
Case 19: Str = "Thu phaan"
Case 20: Str = "Hafn looj"
Case 21: Str = "Suwowng giasng"
Case 22: Str = "Laajp ddoong"
Case 23: Str = "Tieeru tuyeest"
Case 24: Str = "Ddaji tuyeest"
Case VN("Ddoong chis"): Num = 1
Case VN("Tieeru hafn"): Num = 2
Case VN("Ddaji hafn"): Num = 3
Case VN("Laajp xuaan"): Num = 4
Case VN("Vux thuyr"): Num = 5
Case VN("Kinh chaajp"): Num = 6
Case VN("Xuaan phaan"): Num = 7
Case VN("Thanh Minh"): Num = 8
Case VN("Coosc vux"): Num = 9
Case VN("Laajp haj"): Num = 10
Case VN("Tieeru maxn"): Num = 11
Case VN("Mang churng"): Num = 12
Case VN("Haj chis"): Num = 13
Case VN("Tieeru thuwr"): Num = 14
Case VN("Ddaji thuwr"): Num = 15
Case VN("Laajp thu"): Num = 16
Case VN("Suwr thuwr"): Num = 17
Case VN("Bajch looj"): Num = 18
Case VN("Thu phaan"): Num = 19
Case VN("Hafn looj"): Num = 20
Case VN("Suwowng giasng"): Num = 21
Case VN("Laajp ddoong"): Num = 22
Case VN("Tieeru tuyeest"): Num = 23
Case VN("Ddaji tuyeest"): Num = 24
End Select
If j = "FALSE" Then
If i < 25 Then TietKhi = VN(Str) Else TietKhi = Num
Else
If j <> "TRUE" Then
If i < 25 Then TK = i Else TK = Num
Ngaytim = jdFromDate(20, 12, j - 1, 0, 0, 0, Timezone)
Ngaytim = Ngaytim + 15 * (TK - 1)
TD = 270 + 15 * (TK - 1)
If TD >= 360 Then TD = TD - 360
D = getSunLongitude(Ngaytim, Timezone, True)
Do While D < TD
Ngaytim = Ngaytim + 1
D = getSunLongitude(Ngaytim, Timezone, True)
Loop
' Do While D > TD
' Ngaytim = Ngaytim - 1
' D = getSunLongitude(Ngaytim, Timezone, True)
' Loop
' Ngaytim = Ngaytim + 1
Ngay1 = Ngaytim - 1
Ngay2 = Ngaytim
Do While (Ngay1 + 1 / 86400) < Ngay2
Ngaytim = (Ngay1 + Ngay2) / 2
D = getSunLongitude(Ngaytim, Timezone, True)
If D < TD Then Ngay1 = Ngaytim Else Ngay2 = Ngaytim
Loop
TietKhi = jdToDate(Ngaytim)
Else
Ngaytim = jdFromDate(day(i), month(i), year(i), Hour(i), Minute(i), Second(i), Timezone)
D = getSunLongitude(Ngaytim, Timezone, True)
If D >= 270 Then Num = Int((D - 270) / 15) + 1 Else Num = Int(D / 15) + 7
TietKhi = Num
End If
End If
End Function
