Mình thích viết Blog, tìm hiểu Tử Vi, Phong Thủy, Kiến Trúc, nghiên cứu Lịch vạn niên, đọc sách tùm lum, hay chia sẽ kiến thức.

  • GHIM NỔI BẬT

    Thứ Sáu, 3 tháng 4, 2020

    LỊCH VẠN NIÊN TTL-EXCEL

    Đây là bộ lịch vạn sự soạn thảo công phu, được rất nhiều nhà tuyển trạch sử dụng! Và nó sẽ còn được tiếp tục phát triển. 

    TẢI LỊCH VẠN NIÊN BẢN MỚI NHẤT

    (có nhiều ứng dụng thiên văn, chạy trên máy tính)
    Nhấn để tải về:



    (Đã chỉnh sửa và cập nhật lại ngày 23/6/2016)
    Có sự góp ý của rất nhiều người dùng
    Bản tiếp theo sẽ có phần an sao tử vi và luận giả lá số thông minh.

    Lịch vạn niên năm 2020




    Bản đồ sao được nhúng vào lịch
    Các bạn thân mến! Blog TTL đã giới thiệu thuật toán tính Âm Lịch của Hồ Ngọc Đức bằng ngôn ngữ JavaScript, Đây là thuật toán Thiên văn của quốc tế. Bạn có thể xem bài viết này tại: 

    Còn ở bài viết này tôi sẽ giới thiệu cho bạn thuật toán tính âm lịch của Hồ Ngọc Đức bằng ngôn ngữ Viasual Basic do Blog TTL chuyển từ ngôn JavaScript. Và File Excel Lịch Vạn Niên xây dựng từ thật toán trên và các tài liệu xem ngày tháng. Nhưng tôi sẽ giới thiệu về File Lịch Vạn Niên trước, thuật toán giới thiệu sau.
    File Lịch Vạn Niên là một chương trình xử lý, tính toán một ngày dương nào đó thành ngày âm lịch và các vạn sự của ngày.

    Ví dụ như ngày Dương là ngày 01 tháng 01 năm 2013, thì kết quả cơ bản từ chương trình Lịch Vạn Niên là:
    • Là ngày Hoàng Đạo
    • Ngày thứ 3
    • Ngày theo lịch Julius: 2456294
    • Ngày âm lịch: 20/11/2012 ngày Đinh Mão tháng Nhâm Tý năm Nhâm Thìn
    • Mệnh ngày là Hỏa (lửa trong lò), mệnh tháng là Mộc (gỗ cây dâu), mệnh năm là Thủy (nước giữa dòng)
    • Ngày này đang ở trong tiết Đông Chí (giữa đông - kinh độ mặt trời là 280.43 độ)
    • Từ 23h đến 01h là giờ Canh Tý thần Tư Mệnh quản, giờ này là giờ Hắc Đạo, còn từ 01h đến 03h ....
    • Ngày này thì hướng Hỷ thần là Chính Nam, Tài thần là Chính Tây, Hạc thần là Chính Nam, giờ không vong tại Dậu, Hợi, Giờ tốt: Dần, Mão, Ngọ, Mùi
    •  Các sao tốt chiếu trong ngày này: Nguyện Đức Hợp, Thiên Thành...
    • Các sao xấu chiếu trong ngày này: Thiên Cương, Thiên Lại...
    • Các phần vạn sự A, B,C,D,E,F ...
    • ............................

    Ngoài ra còn có thêm 3 phần là: Xem Giờ Sinh, Bát Trạch, Ngày Đặc Biệt Của Bạn:
    • Phần Xem Giờ Sinh được viết theo sách Ngọc Hạp Chánh Tông. Phần này bạn chỉ nên xem cho vui, đừng tin quá.
    • Phần Bát Trạch được xây dựng dựa theo sách Phong Thủy Ứng Dụng. Phần này ứng dụng cho việc bài trí nội thất, ngoại thất.
    • Phần Ngày Đặc Biệt là phần bạn nhập ngày mà bạn cần nhớ của mình vào, Lịch vạn niên khi chỉ tới ngày đó sẽ báo cho bạn. Ví dụ ngày sinh của bạn là 20/10/1984 Âm Lịch thì đến ngày 20/10 âm lịch của các năm sẽ hiện dòng nhắc sinh nhật của bạn.
    Tuy nhiên bản Lịch Vạn Niên này chắc chắn không ít thì nhiều có chổ sẽ sai, nếu ai phát hiện lỗi sai sót thì comment dùm nha. Ngoài ra mong bà con bàn luận chi sẽ, góp ý để hoàn thành Lịch Vạn Niên này tốt hơn.

    Ghi chú Lịch Vạn Niên này là file Excel có chứa các Macro nên bạn phải đưa chế độ bảo vệ của Excel về mức Low mới xem được.  Phần Bát Trạch, nếu bạn dùng thì phải dùng Excel 2007 trở lên, excel 2003 sẽ bị lỗi. 


    TẢI LỊCH VẠN NIÊN MỚI NHẤT


    Riêng phần tính giờ nước lên, nước xuống thì mình chưa có thuật toán tính, nên mục này bà con xem thận trọng nha. Ai có thật toán tính giờ con nước thì chỉ mình với.

    Các bạn có thể thảm khảo bài viết: Cách Tính Giờ Âm Lịch để hiểu hơn về chương trình này

    Còn đây là thuật toán:


    Option Explicit ' TRAN TU LIEM
    Const PI As Double = 3.14159265358979 ' Atn(1) * 4

    Function jdFromDate(ByVal dd As Long, ByVal mm As Long, ByVal yy As Long) As Long
        Dim a As Double, y As Long, M As Long, jd As Long
        a = Fix((14 - mm) / 12)
        y = yy + 4800 - a
        M = mm + 12 * a - 3
        jd = dd + Fix((153 * M + 2) / 5) + 365 * y _
            + Fix(y / 4) - Fix(y / 100) + Fix(y / 400) - 32045
        If jd < 2299161 Then
            jd = dd + Fix((153 * M + 2) / 5) + 365 * y + Fix(y / 4) - 32083
        End If
        jdFromDate = jd
    End Function

    Function jdToDate(jd)
    ' doi ngay july thành ngay thuong
    Dim a, b, c, d, e, M, Day, Month, Year
    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 = DateSerial(Year, Month, Day)

    End Function

    Function NewMoon(ByVal k As Long) As Double
        Dim T As Double, T2 As Double, T3 As Double, dr As Double
        Dim Jd1 As Double, M As Double, Mpr As Double
        Dim F As Double, C1 As Double, deltat As Double, JdNew As Double
        T = k / 1236.85 ' Time in Julian centuries from 1900 January 0.5
       T2 = T * T
        T3 = T2 * T
        dr = 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)
        M = 359.2242 + 29.10535608 * k - 0.0000333 * T2 - 0.00000347 * T3
        Mpr = 306.0253 + 385.81691806 * k + 0.0107306 * T2 + 0.00001236 * T3
        F = 21.2964 + 390.67050646 * k - 0.0016528 * T2 - 0.00000239 * T3
        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
        NewMoon = JdNew
    End Function

    Function SunLongitude(ByVal jdn As Double) As Double
        Dim T As Double, T2 As Double, dr As Double, M As Double
        Dim L0 As Double, DL As Double, L As Double
        T = (jdn - 2451545) / 36525
            ' Time in Julian centuries from 2000-01-01 12:00:00 GMT
       T2 = T * T
        dr = PI / 180 ' degree to radian
       M = 357.5291 + 35999.0503 * T - 0.0001559 * T2 - 0.00000048 * T * T2
        L0 = 280.46645 + 36000.76983 * T + 0.0003032 * T2
        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
       L = L * dr
        L = L - PI * 2 * (Fix(L / (PI * 2))) ' Normalize to (0, 2*PI)
       SunLongitude = L
    End Function

    Function getSunLongitude(ByVal dayNumber As Double, ByVal timeZone As Byte) As Long
        getSunLongitude = Fix(SunLongitude(dayNumber - 0.5 - timeZone / 24) / PI * 6)
    End Function

    Function getNewMoonDay(ByVal k As Long, ByVal timeZone As Long) As Long
        getNewMoonDay = Fix(NewMoon(k) + 0.5 + timeZone / 24)
    End Function

    Function getLunarMonth11(ByVal yy As Long, ByVal timeZone As Long) As Long
        Dim k As Long, off As Double, nm As Long, sunLong As Double
        off = jdFromDate(31, 12, yy) - 2415021
        k = Fix(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)
        End If
        getLunarMonth11 = nm
    End Function


    Function getLeapMonthOffset(ByVal a11 As Double, ByVal timeZone As Long) As Long
        Dim k As Long, last As Long, Arc As Long, I As Long
        k = Fix((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
            last = Arc
            I = I + 1
            Arc = getSunLongitude(getNewMoonDay(k + I, timeZone), timeZone)
        Loop While (Arc <> last And I < 14)
        getLeapMonthOffset = I - 1
    End Function


    Public Function KinhDoMatTroi(gio, phut, dd, mm, yy)
    'tinh kinh ?o mat troi
    Dim PI, a, y, M, T, jdn, L0, jd, c, theta, lambda
    PI = 4 * Atn(1)
    a = Int((14 - mm) / 12)
    y = yy + 4800 - a
    M = mm + 12 * a - 3
        jdn = dd + Int(((153 * M) + 2) / 5) + 365 * y + Int(y / 4) - Int(y / 100) + Int(y / 400) - 32045
        If jdn < 2299161 Then jdn = dd + Int((153 * M + 2) / 5) + 365 * y + Int(y / 4) - 32083
        jd = jdn + ((gio - 12) / 24) + (phut / 1440) - 7 / 24


    T = (jd - 2451545#) / 36525
    L0 = 280.46645 + 36000.76983 * T + 0.0003032 * T * T
    M = (357.5291 + 35999.0503 * T - 0.0001559 * T * T - 0.00000048 * T * T * T) * PI / 180
    c = ((1.9146 - 0.004817 * T - 0.000014 * T * T) * Sin(M)) + (0.01993 - 0.000101 * T) * Sin(2 * M) + 0.00029 * Sin(3 * M)
    theta = L0 + c
    lambda = theta - 0.00569 - 0.00478 * Sin((125.04 - 1934.136 * T) * PI / 180)
    lambda = lambda - 360 * Int(lambda / 360)
    KinhDoMatTroi = lambda

    End Function













    Function convertSolar2Lunar(dd, mm, yy, timeZone)

    'Doi ngày duong dd/mm/yyyy ra ngày âm

    Dim k, dayNumber, monthStart, a11, b11, lunarDay, lunarMonth, lunarYear, lunarLeap, diff, leapMonthDiff
    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
     
    convertSolar2Lunar = lunarDay & "/" & lunarMonth & "/" & lunarYear

    End Function

    Function THANGNODU(dd, mm, yy, timeZone)

    'THANG NO DU

    Dim k, dayNumber, monthStart, a11, b11, lunarDay, lunarMonth, lunarYear, lunarLeap, diff, leapMonthDiff
    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
     
    THANGNODU = getNewMoonDay(k + 1, timeZone) - getNewMoonDay(k, timeZone)

    End Function

    Function THANGNHUAN(dd, mm, yy, timeZone)

    'THANG NHUAN

    Dim k, dayNumber, monthStart, a11, b11, lunarDay, lunarMonth, lunarYear, lunarLeap, diff, leapMonthDiff
    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)

        THANGNHUAN = (leapMonthDiff + 10) Mod 12
    End If

     


    End Function






    Function convertLunar2Solar(lunarDay, lunarMonth, lunarYear, lunarLeap, timeZone)

    'Doi âm lich ra duong lich

    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
            convertLunar2Solar = Array(0, 0, 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)
    convertLunar2Solar = jdToDate(monthStart + lunarDay - 1)

    End Function


    Function Ngay(dd, mm, yy, timeZone)

    'Doi ngày duong dd/mm/yyyy ra ngày âm: Ngay

    Dim k, dayNumber, monthStart, a11, b11, lunarDay, lunarMonth, lunarYear, lunarLeap, diff, leapMonthDiff
    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
     
    Ngay = lunarDay
    End Function
    Function Thang(dd, mm, yy, timeZone)

    'Doi ngày duong dd/mm/yyyy ra ngày âm: Thang

    Dim k, dayNumber, monthStart, a11, b11, lunarDay, lunarMonth, lunarYear, lunarLeap, diff, leapMonthDiff
    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
     
    Thang = lunarMonth

    End Function

    Function Nam(dd, mm, yy, timeZone)

    'Doi ngày duong dd/mm/yyyy ra ngày âm

    Dim k, dayNumber, monthStart, a11, b11, lunarDay, lunarMonth, lunarYear, lunarLeap, diff, leapMonthDiff
    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
     
    Nam = lunarYear

    End Function

    Function Duongcongkynhat(dd, mm, yy, timeZone)

    'Doi ngày duong dd/mm/yyyy ra ngày âm

    Dim k, dayNumber, monthStart, a11, b11, lunarDay, lunarMonth, lunarYear, lunarLeap, NgayAm, diff, leapMonthDiff
    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
     
    NgayAm = lunarDay & "/" & lunarMonth
    Duongcongkynhat = ""

    If NgayAm = "13/1" Or NgayAm = "11/2" Or NgayAm = "9/3" Or NgayAm = "7/4" Or NgayAm = "5/5" Or NgayAm = "3/6" Or NgayAm = "8/7" Or NgayAm = "29/7" Or NgayAm = "27/8" Or NgayAm = "25/9" Or NgayAm = "23/10" Or NgayAm = "21/11" Or NgayAm = "19/12" Then Duongcongkynhat = 1

    End Function

    Function TamNuongSat(dd, mm, yy, timeZone)

    'Kiem tra ngay dd/mm/yyyy có phai ngay Tam Nuong Sat

    Dim k, dayNumber, monthStart, a11, b11, lunarDay, lunarMonth, lunarYear, lunarLeap, TamNuong, diff, leapMonthDiff
    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
     

    TamNuongSat = ""

    If lunarDay = 2 Or lunarDay = 7 Or lunarDay = 13 Or lunarDay = 18 Or lunarDay = 22 Or lunarDay = 27 Then TamNuongSat = 1

    End Function

    Function NgayNguyetKy(dd, mm, yy, timeZone)

    'Kiem tra ngay dd/mm/yyyy có phai ngay Nguyet Ky

    Dim k, dayNumber, monthStart, a11, b11, lunarDay, lunarMonth, lunarYear, lunarLeap, TamNuong, diff, leapMonthDiff
    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
     

    NgayNguyetKy = ""

    If lunarDay = 5 Or lunarDay = 14 Or lunarDay = 23 Then NgayNguyetKy = 1

    End Function

    Thân ái
    Blog Trần Tứ Liêm

    24 nhận xét:

    1. Cảm ơn phần Comment của bạn! Tớ đã chỉnh lại rồi, sai một xíu xíu trong thuật toán nhưng tớ mất khá nhiều thời gian để sửa nó. Bạn hãy tải lại và dùng xem nhé.

      Phần tính tiết khí vào thì mình tính bằng kinh độ mặt trời vào lúc 0 phut 0 giờ của ngày hiện tại, cách tính này là sai. phải tính vào lúc cuối ngày mới đúng, tức khoảng 59 phút 23h mới đúng.

      Cái này mình củng sửa lại rồi! Rất cảm ơn bạn và muốn có thêm sự góp ý để hoàn chỉnh chương trình này!

      Trả lờiXóa
      Trả lời
      1. Xin cám ơn cả hai anh: Hồ Ngọc Đức và Trần Tứ Liêm. Chúc hai anh lúc nào cũng đầy đủ sức khoẻ, trí tuệ, niềm vui trong cuộc đời.

        Xóa
    2. chào Bạn,

      Trong thuật toán trên rất hữu ích cho các bạn viết code vba ứng dụng trong excel

      Tuy nhiên thuật toán trên vẫn thiếu một hàm trả về ngày tiết khí đầu tiên, mình nghĩ nếu bổ sung vào thư viện code vba sẽ rất hữu ích

      ví dụ: nhập ngày 10/6/2013 => tiết khí: "Mang chủng" ngày tiết khí đầu tiên là ngày 5/6/2013
      or nhập ngày 18/5/2013 => tiết khí: "Lập hạ" ngày tiết khí đầu tiên là ngày 5/5/2013
      v.v
      Code này rất thuận tiện để liệt kê 24 ngày tiết khí đầu tiên của năm.

      Trân trọng,
      Tâm

      Trả lờiXóa
    3. em k rành vụ excel này lắm, chỉ tải về để dùng thôi, rất chi là hay.
      anh nói: "Ngoài ra còn có thêm 3 phần là: Xem Giờ Sinh, Bát Trạch, và Ngày Đặc Biệt Của Bạn"
      vậy 3 phần này ở đâu vậy
      e dùng Official 2007

      thank anh

      Trả lờiXóa
    4. a có thể đưa dữ liệu trong các ô excel lên k ạ

      Trả lờiXóa
    5. Chào bạn,

      Trong source code trên mình chép vào excel để sử dụng thấy bị sai phần chuyển đổi dương lịch sang âm lịch.
      vd: nhập ngày 28 tháng 1 năm 1971=>âm lịch: 02/12/1970
      ngày âm lịch nên là : 02/01/1971.

      Thanks,

      Trả lờiXóa
    6. Liêm có bảng web không vậy?

      Trả lờiXóa
    7. Vào link nhưng không tải được.
      Phiền anh xem lại giúp
      Cám ơn anh

      Trả lờiXóa
    8. Chào anh/chị. Mình thấy có lịch vạn niên hẳn người viết rất am hiểm về vấn đề này, vậy xin trả lời giúp tôi sinh ngày 15/01/1985 âm lịch là ngày nào? Mình đã từng tìm hiểu về khoảng thời gian này, có lịch thì là 24-25/11 âm lịch, có lịch là 25-26/12 âm lịch năm Giáp tý? vậy làm thế nào tôi tìm chính xác ngày sinh của tôi?

      Trả lờiXóa
      Trả lời
      1. Chào bạn! bạn sinh ngày 15/01/1985 dương lịch. Tức ngày âm lịch là: 25 tháng 12 năm 1984 (ngày Giáp Dần, tháng Đinh Sửu, năm Giáp Tý)

        Xóa
      2. cái này thì đơn giản mà lên mạng là biết ngay thôi mà

        Xóa
      3. Chính xác là như vậy đó bạn, 95% người dùng tra cứu thường như vậy

        Xóa
    9. http://www.mediafire.com/download/a68o25pg2i10so3/lich+van+nien+excel+v1.1.rar
      Link bên trên hỏng rồi Bạn ơi

      Trả lờiXóa
      Trả lời
      1. Bạn tải lại nhé! Hôm trước mình đóng lại không cho tải, vì chuẩn bị có bản mới V1.2

        Xóa
    10. Phần hàm tính tháng nhuận có vẻ có vấn đề.
      Đề nghị a. Liêm kiểm tra lại.

      Trả lờiXóa
    11. https://trantuliem.blogspot.com/2014/03/truyen-tranh-trang-quynh-online-full.html
      https://trantuliem.blogspot.com/2018/08/lich-van-nien-nam-2019.html

      Trả lờiXóa

    Nếu bạn có ý kiến gì không?

    QUẢNG CÁO

    RAM HÀ TÌNH - BÁNH CUỐN CHẢ GIÒ

    Ram - 45.000đ/tệp

    HÀNH TĂM

    Hành tăm - 80.000đ/kg

    KHÔ CÁ CƠM BẠC

    Cá cơm bạc: 250K/kg

    KHÔ CÁ CƠM CON

    Cá cơm - 200k/kg

    MẮM TÔM

    Mắm tôm - 90k/kg

    TÉP KHÔ

    Tép khô - 250K/kg

    MẬT MÍA

    Mật mía - 80K/lít

    CHIM BỒ CÂU NON

    Bồ câu - 100K/con

    MĂNG KHÔ

    Măng khô - 300K/kg

    THUỐC VIÊM XOANG

    Thốc trị viêm xoang


    SHOP HẢI YẾN - ĐẶC SẢN QUÊ HÀ TĨNH

    CHUYÊN CUNG CẤP CÁC ĐẶT SẢN MIỀN TRUNG TỪ HÀ TĨNH NGHỆ AN
    Bánh ram Hà Tĩnh - Hành Tăm - Cá khô - Mực khô - vv...

    Hotline: 0978905921 (zalo)
    Địa chỉ: 12/68A Đường Thạnh Lộc 27, Phường Thạnh Lộc, Quận 12, TPHCM

    SHOP HẢI YÊN