Thủ Thuật Excel Facebook 2019-10-15T08:48:34Z Có rất nhiều ứng dụng lịch âm dương , nhưng bạn muốn xây dựng lịch âm dương bằng excel , sẽ có một vài viết hướng dẫn chi tiết sau, còn...

Hàm Excel Chuyển Đổi Dương Lịch Âm Lịch

In ra - Lưu thành PDF - Gửi qua email


Có rất nhiều ứng dụng lịch âm dương, nhưng bạn muốn xây dựng lịch âm dương bằng excel, sẽ có một vài viết hướng dẫn chi tiết sau, còn ở bài viết này sẽ hướng dẫn các bạn xây dựng hàm để chuyển đổi từ dương lịch sang âm lịch và ngược lại.

Mặc định trong excel không có hàm để chuyển đổi từ dương lịch sang âm lịch và ngược lại, chúng ta sẽ xây dựng hàm tự tạo bằng VBA, đầu tiên các bạn mở file excel bất kỳ lên, sau đó nhấn phím tắt Alt + F11 để gọi chương trình VBA, sau đó vào Insert - Module


Copy đoạn code bên dưới và dán vào khung soạn thảo

 Option Explicit
 Public Lday, Lmonth As Byte, Lyear As Integer, isLeap, LunarInfo
 'Ho ngoc Duc, truongphu chú thích
 Sub lunar(d, m, y)
 Dim DiffADate, Counter, i, Temp, Leap
     ' tính sô ngày tù môc 1/31/1900   'ghi chú: d se Ðuoc xem nhu month
     DiffADate = DateDiff("d", #1/31/1900#, CDate(m & "-" & d & "-" & y))
     Counter = -1 'ngày 31/1/1900 có DateDiff = 0 tuong úng ÂL là ngày 1
         'nên counter = -1 vì ngày ÂL = DateDiff - counter
     Lyear = 1900  'nam bat Ðâu tính, Lyear là nam ÂL tuong Ðuong DL
         For i = Lyear To 2199 ' Ðêm trong 300 nam kê tiêp
             Temp = YearDays(i) 'goi Function YearDays nam Ðang Ðêm = sô ngày/nam
             Counter = Counter + Temp 'cong sô ngày dôn
 If Counter >= DiffADate Then                  'nêu sô ngày dôn >= DiffADate
                     Counter = Counter - Temp ' tru` sô ngày dôn 1 nam Ðang tính
                     Exit For  'và thoát vòng lap, = Ðã có giá tri Lyear
 End If
             Lyear = Lyear + 1 'nam Ðang Ðêm thêm 1 don vi
         Next
  'so' di phai tính nhu thê Ðê tìm chính xác nhung ngày cuôi nam ÂL mà Ðã sang nam mo'i DL
  'trong truong hop nây, xem nhu vân nam cu
 Leap = LeapMonth(Lyear) ' goi hàm LeapMonth, tháng nhuân là tháng mây?
 isLeap = "" ' set giá tri xác Ðinh cua tháng nhuân = ""
 Lmonth = 1

 For i = 1 To 12
 If Leap > 0 And i = Leap + 1 And isLeap = "" Then
 isLeap = "(N)" 'nêu tháng nhuân có và I lo'n hon 1 thì Nhuân
 Lmonth = Lmonth - 1 'tháng lùi 1
 i = i - 1 'Ðêm lùi 1
 Temp = LeapDay(Lyear) ' goi hàm leapday, tính sô ngày nhuân
 Else
 Temp = MonthDays(Lyear, i) 'goi hàm monthdays tính sô ngày thuong
 End If

 If isLeap = "(N)" And i <> Leap Then isLeap = ""
  ' Nêu xác dinh Nhuân và I khác tháng nhuân thì Xác Ðinh không phai Nhuan
 Counter = Counter + Temp ' cong dôn ngày tù vi trí Exit For khi xác Ðinh Lyear

 If Counter >= DiffADate Then  'nêu sô ngày dôn >= DiffADate
 Counter = Counter - Temp ' tru` sô ngày dôn 1 tháng Ðang tính
 Exit For   'và thoát vòng lap, = Ðã có giá tri Lmonth
 End If
 Lmonth = Lmonth + 1 'tháng Ðang Ðêm thêm 1 don vi
 Next
 Lday = DiffADate - Counter 'Ngày Ðuoc xác Ðinh
 End Sub
 Function LeapMonth(y) ''''''''''''
 If y >= 1900 Then LeapMonth = LunarInfo(y - 1900) And &HF Else LeapMonth = 0
 'Tháng nhuân = LunarInfo(nam Ðang chuyên) And &HF = ( tu 0 - 12) ngoài ra thì = 0
 End Function

 Function LeapDay(y) ''''''''''
 If LunarInfo(y - 1900) And &HF Then  'nêu có tháng nhuân thì
 If LunarInfo(y - 1900) And &H10000 Then LeapDay = 30 Else LeapDay = 29
 ' Nêu LunarInfo(nam Ðang chuyên) And &H10000 > 0 thì 30 không thì 29 ngày
 Else
 LeapDay = 0
 End If
 End Function

 Function MonthDays(y, m) '''''''''''''''
 Dim MonthMask
 MonthMask = Array(32768, 16384, 8192, 4096, 2048, 1024, 512, 256, 128, 64, 32, 16)
 ' Mang loc tháng(1-12) = MonthMask(0-11)
 ' Nêu LunarInfo(nam Ðang chuyên) And Mang loc tháng(tháng Ðang chuyên) > 0 thì 30 ngoài ra thì 29
 If LunarInfo(y - 1900) And MonthMask(m - 1) Then MonthDays = 30 Else MonthDays = 29
 End Function

 Function YearDays(y) '''''''''''''
 Dim i, MonthMask
 MonthMask = Array(32768, 16384, 8192, 4096, 2048, 1024, 512, 256, 128, 64, 32, 16)
 YearDays = 348  '12 tháng x 29 ngày
 For i = 0 To 11 'tháng nào có 30 ngày thì thêm 1
 If LunarInfo(y - 1900) And MonthMask(i) Then YearDays = YearDays + 1
 Next
 YearDays = YearDays + LeapDay(y) ' cong thêm sô ngày nhuân nêu có
 End Function
 'Ham so chuyen doi tu Duong lich sang Am lich dang ngay,thang,nam
 Public Function TransLu(d, m, y)
 Call Goi
 ' cau trúc cua hàm lunar là (d, m, y), VB6 dùng (m, d, y) nên function TransLu
 ' se doi vi tri câu trúc khi goi hàm lunar
 Call lunar(m, d, y)
 TransLu = Lday & "/" & Lmonth & isLeap & "/" & Lyear
 End Function
 'Ham so chuyen doi tu Duong lich sang Am lich dang tu mot o
 Public Function TransLu1(NT As Date) ' NT = ngày tháng
 Call lunar(Day(NT), Month(NT), Year(NT)) 'goi hàm Lunar theo câu trúc nây ?
 ' Ðê nghi nhu' hàm TransLu làm: Call lunar(Month(NT), Day(NT), Year(NT))
 'TransLu1 = Lday & "-" & Lmonth & isLeap & "-" & CanchiV(Lyear - 0)
                                 'Hàm CanchiV bi thiêu!
 End Function

 Public Function TransSolar(d, m, y) As Date 'Ngay thang nam am lich sang duong lich
 Dim iSd As Date
 iSd = DateSerial(y, m, d) - 70
 Do
 iSd = iSd + 1
 Loop Until TransLu(Day(iSd), Month(iSd), Year(iSd)) = d & "/" & m & "/" & y
 TransSolar = iSd
 End Function

 'Cach su dung:
 Private Sub Command1_Click()
     If Days = "" Or Months = "" Or Years = "" Then Exit Sub
     NgayAL = TransLu(Days, Months, Years)
 End Sub

 Private Sub Command2_Click()
 If Years = "" Then Exit Sub
 ThangNhuan = LeapMonth(Years)
 End Sub

 Private Sub Command3_Click()
 If Years = "" Then Exit Sub
 SoNgayNhuan = LeapDay(Years)
 End Sub

 Private Sub Command4_Click()
 If Years = "" Or Months = "" Then Exit Sub
 SoNgayThangT = MonthDays(Years, Months)
 End Sub

 Private Sub Command5_Click()
 If Years = "" Then Exit Sub
 SoNgayNam = YearDays(Years)
 End Sub

 Sub Goi()
 'Mang do HoNgocDuc tu xây dung, chu'a thông tin nam ÂL tu 1900-2199
 'nam Ðó tháng mây nhuân? gôm mây ngày? Môi tháng còn lai có mây ngày? nam Ðó có mây ngày?
 LunarInfo = Array( _
 &H3C4BD8, &H624AE0, &H4CA570, &H3854D5, &H5CD260, &H44D950, &H315554, &H5656A0, &H409AD0, &H2A55D2, &H504AE0, &H3AA5B6, &H60A4D0, &H48D250, &H33D255, &H58B540, &H42D6A0, &H2CADA2, &H5295B0, &H3F4977, _
 &H644970, &H4CA4B0, &H36B4B5, &H5C6A50, &H466D40, &H2FAB54, &H562B60, &H409570, &H2C52F2, &H504970, &H3A6566, &H5ED4A0, &H48EA50, &H336A95, &H585AD0, &H442B60, &H2F86E3, &H5292E0, &H3DC8D7, &H62C950, _
 &H4CD4A0, &H35D8A6, &H5AB550, &H4656A0, &H31A5B4, &H5625D0, &H4092D0, &H2AD2B2, &H50A950, &H38B557, &H5E6CA0, &H48B550, &H355355, &H584DA0, &H42A5B0, &H2F4573, &H5452B0, &H3CA9A8, &H60E950, &H4C6AA0, _
 &H36AEA6, &H5AAB50, &H464B60, &H30AAE4, &H56A570, &H405260, &H28F263, &H4ED940, &H38DB47, &H5CD6A0, &H4896D0, &H344DD5, &H5A4AD0, &H42A4D0, &H2CD4B4, &H52B250, &H3CD558, &H60B540, &H4AB5A0, &H3755A6, _
 &H5C95B0, &H4649B0, &H30A974, &H56A4B0, &H40AA50, &H29AA52, &H4E6D20, &H39AD47, &H5EAB60, &H489370, &H344AF5, &H5A4970, &H4464B0, &H2C74A3, &H50EA50, &H3D6A58, &H6256A0, &H4AAAD0, &H3696D5, &H5C92E0, _
 &H46C960, &H2ED954, &H54D4A0, &H3EDA50, &H2A7552, &H4E56A0, &H38A7A7, &H5EA5D0, &H4A92B0, &H32AAB5, &H58A950, &H42B4A0, &H2CBAA4, &H50AD50, &H3C55D9, &H624BA0, &H4CA5B0, &H375176, &H5C5270, &H466930, _
 &H307934, &H546AA0, &H3EAD50, &H2A5B52, &H504B60, &H38A6E6, &H5EA4E0, &H48D260, &H32EA65, &H56D520, &H40DAA0, &H2D56A3, &H5256D0, &H3C4AFB, &H6249D0, &H4CA4D0, &H37D0B6, &H5AB250, &H44B520, &H2EDD25, _
 &H54B5A0, &H3E55D0, &H2A55B2, &H5049B0, &H3AA577, &H5EA4B0, &H48AA50, &H33B255, &H586D20, &H40AD60, &H2D4B63, &H525370, &H3E49E8, &H60C970, &H4C54B0, &H3768A6, &H5ADA50, &H445AA0, &H2FA6A4, &H54AAD0, _
 &H4052E0, &H28D2E3, &H4EC950, &H38D557, &H5ED4A0, &H46D950, &H325D55, &H5856A0, &H42A6D0, &H2C55D4, &H5252B0, &H3CA9B8, &H62A930, &H4AB490, &H34B6A6, &H5AAD50, &H4655A0, &H2EAB64, &H54A570, &H4052B0, _
 &H2AB173, &H4E6930, &H386B37, &H5E6AA0, &H48AD50, &H332AD5, &H582B60, &H42A570, &H2E52E4, &H50D160, &H3AE958, &H60D520, &H4ADA90, &H355AA6, &H5A56D0, &H462AE0, &H30A9D4, &H54A2D0, &H3ED150, &H28E952, _
 &H4EB520, &H38D727, &H5EADA0, &H4A55B0, &H362DB5, &H5A45B0, &H44A2B0, &H2EB2B4, &H54A950, &H3CB559, &H626B20, &H4CAD50, &H385766, &H5C5370, &H484570, &H326574, &H5852B0, &H406950, &H2A7953, &H505AA0, _
 &H3BAAA7, &H5EA6D0, &H4A4AE0, &H35A2E5, &H5AA550, &H42D2A0, &H2DE2A4, &H52D550, &H3E5ABB, &H6256A0, &H4C96D0, &H3949B6, &H5E4AB0, &H46A8D0, &H30D4B5, &H56B290, &H40B550, &H2A6D52, &H504DA0, &H3B9567, _
 &H609570, &H4A49B0, &H34A975, &H5A64B0, &H446A90, &H2CBA94, &H526B50, &H3E2B60, &H28AB61, &H4C9570, &H384AE6, &H5CD160, &H46E4A0, &H2EED25, &H54DA90, &H405B50, &H2C36D3, &H502AE0, &H3A93D7, &H6092D0, _
 &H4AC950, &H32D556, &H58B4A0, &H42B690, &H2E5D94, &H5255B0, &H3E25FA, &H6425B0, &H4E92B0, &H36AAB6, &H5C6950, &H4674A0, &H31B2A5, &H54AD50, &H4055A0, &H2AAB73, &H522570, &H3A5377, &H6052B0, &H4A6950, _
 &H346D56, &H585AA0, &H42AB50, &H2E56D4, &H544AE0, &H3CA570, &H2864D2, &H4CD260, &H36EAA6, &H5AD550, &H465AA0, &H30ADA5, &H5695D0, &H404AD0, &H2AA9B3, &H50A4D0, &H3AD2B7, &H5EB250, &H48B540, &H33D556) '' /* Years 2100-2199 */
 End Sub

Như hình


Quay trở lại file excel của bạn, bây giờ chúng ta sẽ chuyển ngày tháng từ dương lịch sang âm lịch và ngược lại.

1. Chuyển Ngày Tháng Từ Dương Lịch Sang Âm Lịch.

Để chuyển ngày tháng từ dương lịch sang âm lịch các bạn sử dụng hàm translu trong excel với cú pháp như sau:

=Translu(DAY(B2);MONTH(B2);YEAR(B2))

Kết quả


Nhưng nếu bạn muốn định dạng lại theo kiểu DD/MM/YYYY thì hãy kết hợp hàm DATEVALUE với chú pháp như sau:

=DATEVALUE(Translu(DAY(B2);MONTH(B2);YEAR(B2)))

Kết quả

2. Chuyển Ngày Tháng Từ Âm Lịch Sang Dương Lịch.

Để chuyển từ âm lịch sang dương lịch các bạn sử dụng hàm TRANSSOLAR với cú pháp:

=TRANSSOLAR(DAY(B8);MONTH(B8);YEAR(B8))

Kết quả


Các bạn có thể tải file excel trên về tham khảo cũng như tìm hiểu thêm ở đây, chú ý bật macro lên trước theo hướng dẫn bật macro trong excel này.


Như vậy là chúng ta vừa đi tìm hiểu cách xây dựng hàm excel chuyển đổi dương lịch âm lịch rồi, và nhân đây xin gửi lời cảm ơn đến tác giả Hồ Ngọc ĐứcTrường Phú về bộ code này, chúc các bạn thành công.


 

Giới Thiệu Về: Thủ Thuật Excel

Là một chuyên trang chia sẻ về các thủ thuật excel và kiến thức tin học văn phòng, tại đây bạn có thể tự học kiến thức cũng như gửi các thắc mắc của mình về những gì liên quan đến excel và tin học văn phòng.

5 Thủ Thuật Excel: Hàm Excel Chuyển Đổi Dương Lịch Âm Lịch Có rất nhiều ứng dụng lịch âm dương , nhưng bạn muốn xây dựng lịch âm dương bằng excel , sẽ có một vài viết hướng dẫn chi tiết sau, còn...

Bài Mới Nhất:
Thủ Thuật Excel
Thủ Thuật Excel