Skip to content

Instantly share code, notes, and snippets.

@touchiep

touchiep/ThaiLunarDateExcel.bas

Last active February 18, 2024 09:21
Show Gist options
  • Save touchiep/99f4f5bb349d6b983ef78697630ab78e to your computer and use it in GitHub Desktop.
Save touchiep/99f4f5bb349d6b983ef78697630ab78e to your computer and use it in GitHub Desktop.
Download ZIP
[VBA][Excel] สูตรสำหรับแปลงวันที่ปกติ (สุริยคติ) เป็น จันทรคติแบบไทย รวมถึงสูตรที่มีไว้สำหรับตรวจสอบ ปีอธิกมาส ปีอธิกวาร และ ปีอธิกสุรทิน
Raw
ThaiLunarDateExcel.bas
Option Explicit
Private Function XLMod(a, b)
'สำหรับใช้แทน mod ของ vba เนื่องจาก mod operator ของ vba ไม่รองรับเลขทศนิยม
XLMod = a - b * Int(a / b)
End Function
Function AthikaMas(iYear As Integer) As Boolean
'สูตรสำหรับคำนวณปีอธิกมาส
'Return True if the specified year is AthikaMas.
'Inspired by Loy's Calculation
Dim Athi
Athi = XLMod((iYear - 78) - 0.45222, 2.7118886)
If Athi < 1 Then
AthikaMas = True
Else
AthikaMas = False
End If
End Function
Function AthikaVar(iYear As Integer) As Boolean
'สูตรสำหรับคำนวณปีอธิกวาร
'Return True if the specified year is AthikaVar.
'Inspired by Loy's Calculation
Dim CutOff
If AthikaMas(iYear) = True Then
AthikaVar = False
Else
If AthikaMas(iYear + 1) = True Then 'ตรวสอบปีถัดไปว่าเป็นอธิกมาสหรือไม่
CutOff = 1.69501433191599E-02 'ปีถัดไปเป็น อธิกมาส
Else
CutOff = -1.42223099315486E-02 'ปีถัดไปเป็น ปกติ
End If
If Deviation(iYear) > CutOff Then 'ถ้าค่าเบี่ยงเบนสูงกว่าค่า cutoff จะเป็นปีอธิกวาร
AthikaVar = True
Else
AthikaVar = False
End If
End If
End Function
Private Function Deviation(iYear As Integer)
'The Deviation calculation for AthikaVar from year 1901 to 2460
'Copyright 2022 and later by Pongsathorn Sraouthai
'Inspired by Loy's Calculation
Dim FDev, Fyear 'The deviation value from year 1901, Buddist Era 2444
Dim CurrDev, lastDev
Dim i As Integer, j As Integer
Dim StartY(1 To 112, 1 To 2)
StartY(1, 1) = 1901
StartY(2, 1) = 1906
StartY(3, 1) = 1911
StartY(4, 1) = 1916
StartY(5, 1) = 1921
StartY(6, 1) = 1926
StartY(7, 1) = 1931
StartY(8, 1) = 1936
StartY(9, 1) = 1941
StartY(10, 1) = 1946
StartY(11, 1) = 1951
StartY(12, 1) = 1956
StartY(13, 1) = 1961
StartY(14, 1) = 1966
StartY(15, 1) = 1971
StartY(16, 1) = 1976
StartY(17, 1) = 1981
StartY(18, 1) = 1986
StartY(19, 1) = 1991
StartY(20, 1) = 1996
StartY(21, 1) = 2001
StartY(22, 1) = 2006
StartY(23, 1) = 2011
StartY(24, 1) = 2016
StartY(25, 1) = 2021
StartY(26, 1) = 2026
StartY(27, 1) = 2031
StartY(28, 1) = 2036
StartY(29, 1) = 2041
StartY(30, 1) = 2046
StartY(31, 1) = 2051
StartY(32, 1) = 2056
StartY(33, 1) = 2061
StartY(34, 1) = 2066
StartY(35, 1) = 2071
StartY(36, 1) = 2076
StartY(37, 1) = 2081
StartY(38, 1) = 2086
StartY(39, 1) = 2091
StartY(40, 1) = 2096
StartY(41, 1) = 2101
StartY(42, 1) = 2106
StartY(43, 1) = 2111
StartY(44, 1) = 2116
StartY(45, 1) = 2121
StartY(46, 1) = 2126
StartY(47, 1) = 2131
StartY(48, 1) = 2136
StartY(49, 1) = 2141
StartY(50, 1) = 2146
StartY(51, 1) = 2151
StartY(52, 1) = 2156
StartY(53, 1) = 2161
StartY(54, 1) = 2166
StartY(55, 1) = 2171
StartY(56, 1) = 2176
StartY(57, 1) = 2181
StartY(58, 1) = 2186
StartY(59, 1) = 2191
StartY(60, 1) = 2196
StartY(61, 1) = 2201
StartY(62, 1) = 2206
StartY(63, 1) = 2211
StartY(64, 1) = 2216
StartY(65, 1) = 2221
StartY(66, 1) = 2226
StartY(67, 1) = 2231
StartY(68, 1) = 2236
StartY(69, 1) = 2241
StartY(70, 1) = 2246
StartY(71, 1) = 2251
StartY(72, 1) = 2256
StartY(73, 1) = 2261
StartY(74, 1) = 2266
StartY(75, 1) = 2271
StartY(76, 1) = 2276
StartY(77, 1) = 2281
StartY(78, 1) = 2286
StartY(79, 1) = 2291
StartY(80, 1) = 2296
StartY(81, 1) = 2301
StartY(82, 1) = 2306
StartY(83, 1) = 2311
StartY(84, 1) = 2316
StartY(85, 1) = 2321
StartY(86, 1) = 2326
StartY(87, 1) = 2331
StartY(88, 1) = 2336
StartY(89, 1) = 2341
StartY(90, 1) = 2346
StartY(91, 1) = 2351
StartY(92, 1) = 2356
StartY(93, 1) = 2361
StartY(94, 1) = 2366
StartY(95, 1) = 2371
StartY(96, 1) = 2376
StartY(97, 1) = 2381
StartY(98, 1) = 2386
StartY(99, 1) = 2391
StartY(100, 1) = 2396
StartY(101, 1) = 2401
StartY(102, 1) = 2406
StartY(103, 1) = 2411
StartY(104, 1) = 2416
StartY(105, 1) = 2421
StartY(106, 1) = 2426
StartY(107, 1) = 2431
StartY(108, 1) = 2436
StartY(109, 1) = 2441
StartY(110, 1) = 2446
StartY(111, 1) = 2451
StartY(112, 1) = 2456
StartY(1, 2) = 0.122733000004352
StartY(2, 2) = 1.91890000045229E-02
StartY(3, 2) = -8.43549999953059E-02
StartY(4, 2) = -0.187898999995135
StartY(5, 2) = -0.291442999994964
StartY(6, 2) = 7.44250000052413E-02
StartY(7, 2) = -2.91189999945876E-02
StartY(8, 2) = -0.132662999994416
StartY(9, 2) = -0.236206999994245
StartY(10, 2) = -0.339750999994074
StartY(11, 2) = -0.443294999993903
StartY(12, 2) = -7.74269999936981E-02
StartY(13, 2) = -0.180970999993527
StartY(14, 2) = -0.284514999993356
StartY(15, 2) = -0.388058999993185
StartY(16, 2) = -0.491602999993014
StartY(17, 2) = -0.595146999992842
StartY(18, 2) = -0.698690999992671
StartY(19, 2) = -0.332822999992466
StartY(20, 2) = -0.436366999992295
StartY(21, 2) = -0.539910999992124
StartY(22, 2) = -0.643454999991953
StartY(23, 2) = 0.253001000008218
StartY(24, 2) = 0.149457000008389
StartY(25, 2) = -0.484674999991406
StartY(26, 2) = -0.588218999991235
StartY(27, 2) = 0.308237000008937
StartY(28, 2) = 0.204693000009108
StartY(29, 2) = 0.101149000009279
StartY(30, 2) = -2.39499999055015E-03
StartY(31, 2) = -0.105938999990379
StartY(32, 2) = 0.259929000009826
StartY(33, 2) = 0.156385000009997
StartY(34, 2) = 5.28410000101682E-02
StartY(35, 2) = -5.07029999896607E-02
StartY(36, 2) = -0.15424699998949
StartY(37, 2) = -0.257790999989318
StartY(38, 2) = 0.108077000010887
StartY(39, 2) = 4.53300001105772E-03
StartY(40, 2) = -9.90109999887712E-02
StartY(41, 2) = -0.2025549999886
StartY(42, 2) = -0.306098999988429
StartY(43, 2) = -0.409642999988258
StartY(44, 2) = -4.37749999880528E-02
StartY(45, 2) = -0.147318999987882
StartY(46, 2) = -0.250862999987711
StartY(47, 2) = -0.354406999987539
StartY(48, 2) = -0.457950999987368
StartY(49, 2) = -0.561494999987197
StartY(50, 2) = -0.665038999987026
StartY(51, 2) = -0.299170999986821
StartY(52, 2) = -0.40271499998665
StartY(53, 2) = -0.506258999986479
StartY(54, 2) = -0.609802999986308
StartY(55, 2) = -0.713346999986137
StartY(56, 2) = 0.183109000014035
StartY(57, 2) = -0.45102299998576
StartY(58, 2) = -0.554566999985589
StartY(59, 2) = 0.341889000014582
StartY(60, 2) = 0.238345000014753
StartY(61, 2) = 0.134801000014924
StartY(62, 2) = 3.12570000150951E-02
StartY(63, 2) = -7.22869999847338E-02
StartY(64, 2) = 0.293581000015471
StartY(65, 2) = 0.190037000015642
StartY(66, 2) = 8.64930000158135E-02
StartY(67, 2) = -1.70509999840154E-02
StartY(68, 2) = -0.120594999983844
StartY(69, 2) = -0.224138999983673
StartY(70, 2) = 0.141729000016532
StartY(71, 2) = 0.038185000016703
StartY(72, 2) = -6.53589999831259E-02
StartY(73, 2) = -0.168902999982955
StartY(74, 2) = -0.272446999982784
StartY(75, 2) = -0.375990999982613
StartY(76, 2) = -1.01229999824075E-02
StartY(77, 2) = -0.113666999982236
StartY(78, 2) = -0.217210999982065
StartY(79, 2) = -0.320754999981894
StartY(80, 2) = -0.424298999981723
StartY(81, 2) = -0.527842999981552
StartY(82, 2) = -0.631386999981381
StartY(83, 2) = -0.265518999981176
StartY(84, 2) = -0.369062999981005
StartY(85, 2) = -0.472606999980834
StartY(86, 2) = -0.576150999980662
StartY(87, 2) = -0.679694999980491
StartY(88, 2) = 0.21676100001968
StartY(89, 2) = -0.417370999980115
StartY(90, 2) = -0.520914999979944
StartY(91, 2) = -0.624458999979773
StartY(92, 2) = 0.271997000020398
StartY(93, 2) = 0.168453000020569
StartY(94, 2) = 6.49090000207404E-02
StartY(95, 2) = -3.86349999790885E-02
StartY(96, 2) = 0.327233000021117
StartY(97, 2) = 0.223689000021288
StartY(98, 2) = 0.120145000021459
StartY(99, 2) = 1.66010000216299E-02
StartY(100, 2) = -0.086942999978199
StartY(101, 2) = -0.190486999978028
StartY(102, 2) = 0.175381000022177
StartY(103, 2) = 7.18370000223483E-02
StartY(104, 2) = -3.17069999774806E-02
StartY(105, 2) = -0.135250999977309
StartY(106, 2) = -0.238794999977138
StartY(107, 2) = -0.342338999976967
StartY(108, 2) = 2.35290000232378E-02
StartY(109, 2) = -8.00149999765911E-02
StartY(110, 2) = -0.18355899997642
StartY(111, 2) = -0.287102999976249
StartY(112, 2) = -0.390646999976078
Select Case iYear
Case Is >= 2456
Fyear = StartY(112, 1)
FDev = StartY(112, 2)
Case Is >= 2451
Fyear = StartY(111, 1)
FDev = StartY(111, 2)
Case Is >= 2446
Fyear = StartY(110, 1)
FDev = StartY(110, 2)
Case Is >= 2441
Fyear = StartY(109, 1)
FDev = StartY(109, 2)
Case Is >= 2436
Fyear = StartY(108, 1)
FDev = StartY(108, 2)
Case Is >= 2431
Fyear = StartY(107, 1)
FDev = StartY(107, 2)
Case Is >= 2426
Fyear = StartY(106, 1)
FDev = StartY(106, 2)
Case Is >= 2421
Fyear = StartY(105, 1)
FDev = StartY(105, 2)
Case Is >= 2416
Fyear = StartY(104, 1)
FDev = StartY(104, 2)
Case Is >= 2411
Fyear = StartY(103, 1)
FDev = StartY(103, 2)
Case Is >= 2406
Fyear = StartY(102, 1)
FDev = StartY(102, 2)
Case Is >= 2401
Fyear = StartY(101, 1)
FDev = StartY(101, 2)
Case Is >= 2396
Fyear = StartY(100, 1)
FDev = StartY(100, 2)
Case Is >= 2391
Fyear = StartY(99, 1)
FDev = StartY(99, 2)
Case Is >= 2386
Fyear = StartY(98, 1)
FDev = StartY(98, 2)
Case Is >= 2381
Fyear = StartY(97, 1)
FDev = StartY(97, 2)
Case Is >= 2376
Fyear = StartY(96, 1)
FDev = StartY(96, 2)
Case Is >= 2371
Fyear = StartY(95, 1)
FDev = StartY(95, 2)
Case Is >= 2366
Fyear = StartY(94, 1)
FDev = StartY(94, 2)
Case Is >= 2361
Fyear = StartY(93, 1)
FDev = StartY(93, 2)
Case Is >= 2356
Fyear = StartY(92, 1)
FDev = StartY(92, 2)
Case Is >= 2351
Fyear = StartY(91, 1)
FDev = StartY(91, 2)
Case Is >= 2346
Fyear = StartY(90, 1)
FDev = StartY(90, 2)
Case Is >= 2341
Fyear = StartY(89, 1)
FDev = StartY(89, 2)
Case Is >= 2336
Fyear = StartY(88, 1)
FDev = StartY(88, 2)
Case Is >= 2331
Fyear = StartY(87, 1)
FDev = StartY(87, 2)
Case Is >= 2326
Fyear = StartY(86, 1)
FDev = StartY(86, 2)
Case Is >= 2321
Fyear = StartY(85, 1)
FDev = StartY(85, 2)
Case Is >= 2316
Fyear = StartY(84, 1)
FDev = StartY(84, 2)
Case Is >= 2311
Fyear = StartY(83, 1)
FDev = StartY(83, 2)
Case Is >= 2306
Fyear = StartY(82, 1)
FDev = StartY(82, 2)
Case Is >= 2301
Fyear = StartY(81, 1)
FDev = StartY(81, 2)
Case Is >= 2296
Fyear = StartY(80, 1)
FDev = StartY(80, 2)
Case Is >= 2291
Fyear = StartY(79, 1)
FDev = StartY(79, 2)
Case Is >= 2286
Fyear = StartY(78, 1)
FDev = StartY(78, 2)
Case Is >= 2281
Fyear = StartY(77, 1)
FDev = StartY(77, 2)
Case Is >= 2276
Fyear = StartY(76, 1)
FDev = StartY(76, 2)
Case Is >= 2271
Fyear = StartY(75, 1)
FDev = StartY(75, 2)
Case Is >= 2266
Fyear = StartY(74, 1)
FDev = StartY(74, 2)
Case Is >= 2261
Fyear = StartY(73, 1)
FDev = StartY(73, 2)
Case Is >= 2256
Fyear = StartY(72, 1)
FDev = StartY(72, 2)
Case Is >= 2251
Fyear = StartY(71, 1)
FDev = StartY(71, 2)
Case Is >= 2246
Fyear = StartY(70, 1)
FDev = StartY(70, 2)
Case Is >= 2241
Fyear = StartY(69, 1)
FDev = StartY(69, 2)
Case Is >= 2236
Fyear = StartY(68, 1)
FDev = StartY(68, 2)
Case Is >= 2231
Fyear = StartY(67, 1)
FDev = StartY(67, 2)
Case Is >= 2226
Fyear = StartY(66, 1)
FDev = StartY(66, 2)
Case Is >= 2221
Fyear = StartY(65, 1)
FDev = StartY(65, 2)
Case Is >= 2216
Fyear = StartY(64, 1)
FDev = StartY(64, 2)
Case Is >= 2211
Fyear = StartY(63, 1)
FDev = StartY(63, 2)
Case Is >= 2206
Fyear = StartY(62, 1)
FDev = StartY(62, 2)
Case Is >= 2201
Fyear = StartY(61, 1)
FDev = StartY(61, 2)
Case Is >= 2196
Fyear = StartY(60, 1)
FDev = StartY(60, 2)
Case Is >= 2191
Fyear = StartY(59, 1)
FDev = StartY(59, 2)
Case Is >= 2186
Fyear = StartY(58, 1)
FDev = StartY(58, 2)
Case Is >= 2181
Fyear = StartY(57, 1)
FDev = StartY(57, 2)
Case Is >= 2176
Fyear = StartY(56, 1)
FDev = StartY(56, 2)
Case Is >= 2171
Fyear = StartY(55, 1)
FDev = StartY(55, 2)
Case Is >= 2166
Fyear = StartY(54, 1)
FDev = StartY(54, 2)
Case Is >= 2161
Fyear = StartY(53, 1)
FDev = StartY(53, 2)
Case Is >= 2156
Fyear = StartY(52, 1)
FDev = StartY(52, 2)
Case Is >= 2151
Fyear = StartY(51, 1)
FDev = StartY(51, 2)
Case Is >= 2146
Fyear = StartY(50, 1)
FDev = StartY(50, 2)
Case Is >= 2141
Fyear = StartY(49, 1)
FDev = StartY(49, 2)
Case Is >= 2136
Fyear = StartY(48, 1)
FDev = StartY(48, 2)
Case Is >= 2131
Fyear = StartY(47, 1)
FDev = StartY(47, 2)
Case Is >= 2126
Fyear = StartY(46, 1)
FDev = StartY(46, 2)
Case Is >= 2121
Fyear = StartY(45, 1)
FDev = StartY(45, 2)
Case Is >= 2116
Fyear = StartY(44, 1)
FDev = StartY(44, 2)
Case Is >= 2111
Fyear = StartY(43, 1)
FDev = StartY(43, 2)
Case Is >= 2106
Fyear = StartY(42, 1)
FDev = StartY(42, 2)
Case Is >= 2101
Fyear = StartY(41, 1)
FDev = StartY(41, 2)
Case Is >= 2096
Fyear = StartY(40, 1)
FDev = StartY(40, 2)
Case Is >= 2091
Fyear = StartY(39, 1)
FDev = StartY(39, 2)
Case Is >= 2086
Fyear = StartY(38, 1)
FDev = StartY(38, 2)
Case Is >= 2081
Fyear = StartY(37, 1)
FDev = StartY(37, 2)
Case Is >= 2076
Fyear = StartY(36, 1)
FDev = StartY(36, 2)
Case Is >= 2071
Fyear = StartY(35, 1)
FDev = StartY(35, 2)
Case Is >= 2066
Fyear = StartY(34, 1)
FDev = StartY(34, 2)
Case Is >= 2061
Fyear = StartY(33, 1)
FDev = StartY(33, 2)
Case Is >= 2056
Fyear = StartY(32, 1)
FDev = StartY(32, 2)
Case Is >= 2051
Fyear = StartY(31, 1)
FDev = StartY(31, 2)
Case Is >= 2046
Fyear = StartY(30, 1)
FDev = StartY(30, 2)
Case Is >= 2041
Fyear = StartY(29, 1)
FDev = StartY(29, 2)
Case Is >= 2036
Fyear = StartY(28, 1)
FDev = StartY(28, 2)
Case Is >= 2031
Fyear = StartY(27, 1)
FDev = StartY(27, 2)
Case Is >= 2026
Fyear = StartY(26, 1)
FDev = StartY(26, 2)
Case Is >= 2021
Fyear = StartY(25, 1)
FDev = StartY(25, 2)
Case Is >= 2016
Fyear = StartY(24, 1)
FDev = StartY(24, 2)
Case Is >= 2011
Fyear = StartY(23, 1)
FDev = StartY(23, 2)
Case Is >= 2006
Fyear = StartY(22, 1)
FDev = StartY(22, 2)
Case Is >= 2001
Fyear = StartY(21, 1)
FDev = StartY(21, 2)
Case Is >= 1996
Fyear = StartY(20, 1)
FDev = StartY(20, 2)
Case Is >= 1991
Fyear = StartY(19, 1)
FDev = StartY(19, 2)
Case Is >= 1986
Fyear = StartY(18, 1)
FDev = StartY(18, 2)
Case Is >= 1981
Fyear = StartY(17, 1)
FDev = StartY(17, 2)
Case Is >= 1976
Fyear = StartY(16, 1)
FDev = StartY(16, 2)
Case Is >= 1971
Fyear = StartY(15, 1)
FDev = StartY(15, 2)
Case Is >= 1966
Fyear = StartY(14, 1)
FDev = StartY(14, 2)
Case Is >= 1961
Fyear = StartY(13, 1)
FDev = StartY(13, 2)
Case Is >= 1956
Fyear = StartY(12, 1)
FDev = StartY(12, 2)
Case Is >= 1951
Fyear = StartY(11, 1)
FDev = StartY(11, 2)
Case Is >= 1946
Fyear = StartY(10, 1)
FDev = StartY(10, 2)
Case Is >= 1941
Fyear = StartY(9, 1)
FDev = StartY(9, 2)
Case Is >= 1936
Fyear = StartY(8, 1)
FDev = StartY(8, 2)
Case Is >= 1931
Fyear = StartY(7, 1)
FDev = StartY(7, 2)
Case Is >= 1926
Fyear = StartY(6, 1)
FDev = StartY(6, 2)
Case Is >= 1921
Fyear = StartY(5, 1)
FDev = StartY(5, 2)
Case Is >= 1916
Fyear = StartY(4, 1)
FDev = StartY(4, 2)
Case Is >= 1911
Fyear = StartY(3, 1)
FDev = StartY(3, 2)
Case Is >= 1906
Fyear = StartY(2, 1)
FDev = StartY(2, 2)
Case Is >= 1901
Fyear = StartY(1, 1)
FDev = StartY(1, 2)
Case Else
Deviation = 0
Exit Function
End Select
'Debug.Print "Select = " & Fyear & " FDev: " & FDev
If iYear = Fyear Then
CurrDev = FDev
Else
Fyear = Fyear + 1
For i = Fyear To iYear
'ถ้า i = ปีเริ่มต้น ให้ใช้ข้อมูลการเบี่ยงเบนของปีเริ่มต้นมาแสดงผล
If i = Fyear Then
lastDev = FDev
Else
lastDev = CurrDev
End If
'ถ้าปีก่อนหน้าเป็นอธิกมาส
If AthikaMas(i - 1) = True Then
CurrDev = -0.102356
'ถ้าปีก่อนหน้าเป็นอธิกวาร
ElseIf AthikaVar(i - 1) = True Then
CurrDev = -0.632944
'ถ้าปีก่อนหน้าเป็นปีปกติ
Else
CurrDev = 0.367056
End If
CurrDev = lastDev + CurrDev
'Debug.Print "First: " & Fyear & " input: " & iYear & " Loop: " & i & " CurrentDev: " & CurrDev
Next i
End If
Deviation = CurrDev
End Function
Private Function LDayInYear(iYear As Integer)
'สำหรับใช้คำนวนวันใน 1 ปี แบบจันทรคติ
'return value of lunar days in year for Thai Lunar Date
If AthikaMas(iYear) = True Then
LDayInYear = 384
ElseIf AthikaVar(iYear) = True Then
LDayInYear = 355
Else
LDayInYear = 354
End If
End Function
Function AthikaSurathin(iYear As Integer) As Boolean
'สูตรสำหรับคำนวณปีอธิกสุรทิน (Leap Year)
'return value true if it is a leap year.
Dim Tmp As Boolean
If iYear Mod 400 = 0 Then
Tmp = True
ElseIf iYear Mod 100 = 0 Then
Tmp = False
ElseIf iYear Mod 4 = 0 Then
Tmp = True
Else
Tmp = False
End If
AthikaSurathin = Tmp
End Function
Private Function NODIYear(iYear As Integer) As Integer
'NODIYEAR = Number of day in the year
'สำหรับแสดงจำนวนวันใน 1 ปีตามแบบสุริยคติ
'Copyright 2022 and later by Pongsathorn Sraouthai
Dim NBDay
If AthikaSurathin(iYear) = True Then
NODIYear = 366
Else
NODIYear = 365
End If
End Function
Function THLDate(iDate As Date, Optional ThaiNumber As Boolean = False, Optional ThaiZodiac As Boolean = False, Optional Era As Integer = 0, Optional ZOption As Boolean = False, Optional Holiday As Boolean = False)
'THLDate = Thai Lunar Date สำหรับแสดงผลวันที่แบบจันทรคติไทย
'แปลงวันที่แบบสุริยคติให้เป็นจันทรคติ
'Copyright 2022 and later by Pongsathorn Sraouthai
'Version 2.0 Optimized for faster calculation
'Inspired by Loy's calculation
'ตัวแปร
'iDate = วันที่ ที่ใช้อ้างอิง
'ThaiNumber = ถ้าเป็น True แสดงผลเลขไทยแทนเลขอารบิก
'ThaiZodiac = ถ้าเป็น True แสดงชื่อปีนักษัตร
'Era = แสดงศักราช 0=ไม่แสดง 1=พุทธศักราช 2=จุลศักราช 3=มหาศักราช 4=รัตนโกสินทร์ศก 5=คริสตศักราช
'Zoption = ตัวเลือกสำหรับการแสดงชื่อปีนักษัตร: False = ใช้รูปแบบราชการ, True = ใช้รูปแบบโหราศาสตร์ไทย
'Holiday = ถ้าเป็น True แสดงชื่อวันสำคัญ
Dim DayInYear
Dim BeginDate As Date
Dim PrevYear, CurrYear
Dim i As Integer, j As Integer
Dim ThM, DofY, DofM, RDayPrev, DayOfYear, DayFromOne, NbLDayYear, ThS, ThZ, ThH, RDayLY
Dim sDate(1 To 56) As Date, cYear
'ตรวจสอบว่าเป็นปีที่รองรับการคำนวณได้หรือไม่
If Year(iDate) < 1903 Or Year(iDate) > 2460 Then
THLDate = "ไม่รองรับ"
Exit Function
End If
'เลือก begin date ให้ใกล้สุดเพื่อที่จะได้ทำงานไวสุด
sDate(1) = DateSerial(1902, 11, 30)
sDate(2) = DateSerial(1912, 12, 8)
sDate(3) = DateSerial(1922, 11, 19)
sDate(4) = DateSerial(1932, 11, 27)
sDate(5) = DateSerial(1942, 12, 7)
sDate(6) = DateSerial(1952, 11, 16)
sDate(7) = DateSerial(1962, 11, 26)
sDate(8) = DateSerial(1972, 12, 5)
sDate(9) = DateSerial(1982, 11, 15)
sDate(10) = DateSerial(1992, 11, 24)
sDate(11) = DateSerial(2002, 12, 4)
sDate(12) = DateSerial(2012, 11, 13)
sDate(13) = DateSerial(2022, 11, 23)
sDate(14) = DateSerial(2032, 12, 2)
sDate(15) = DateSerial(2042, 12, 12)
sDate(16) = DateSerial(2052, 11, 21)
sDate(17) = DateSerial(2062, 12, 1)
sDate(18) = DateSerial(2072, 12, 9)
sDate(19) = DateSerial(2082, 11, 20)
sDate(20) = DateSerial(2092, 11, 28)
sDate(21) = DateSerial(2102, 12, 9)
sDate(22) = DateSerial(2112, 11, 18)
sDate(23) = DateSerial(2122, 11, 28)
sDate(24) = DateSerial(2132, 12, 7)
sDate(25) = DateSerial(2142, 11, 17)
sDate(26) = DateSerial(2152, 11, 26)
sDate(27) = DateSerial(2162, 12, 6)
sDate(28) = DateSerial(2172, 11, 15)
sDate(29) = DateSerial(2182, 11, 25)
sDate(30) = DateSerial(2192, 12, 4)
sDate(31) = DateSerial(2202, 12, 15)
sDate(32) = DateSerial(2212, 11, 24)
sDate(33) = DateSerial(2222, 12, 4)
sDate(34) = DateSerial(2232, 12, 12)
sDate(35) = DateSerial(2242, 11, 23)
sDate(36) = DateSerial(2252, 12, 1)
sDate(37) = DateSerial(2262, 12, 11)
sDate(38) = DateSerial(2272, 11, 20)
sDate(39) = DateSerial(2282, 11, 30)
sDate(40) = DateSerial(2292, 12, 9)
sDate(41) = DateSerial(2302, 11, 20)
sDate(42) = DateSerial(2312, 11, 29)
sDate(43) = DateSerial(2322, 12, 9)
sDate(44) = DateSerial(2332, 11, 18)
sDate(45) = DateSerial(2342, 11, 28)
sDate(46) = DateSerial(2352, 12, 7)
sDate(47) = DateSerial(2362, 12, 17)
sDate(48) = DateSerial(2372, 11, 26)
sDate(49) = DateSerial(2382, 12, 6)
sDate(50) = DateSerial(2392, 12, 14)
sDate(51) = DateSerial(2402, 11, 25)
sDate(52) = DateSerial(2412, 12, 3)
sDate(53) = DateSerial(2422, 12, 13)
sDate(54) = DateSerial(2432, 11, 23)
sDate(55) = DateSerial(2442, 12, 2)
sDate(56) = DateSerial(2452, 12, 11)
cYear = Year(iDate) - 1
Select Case cYear
Case Is > 2452
BeginDate = sDate(56)
Case Is > 2442
BeginDate = sDate(55)
Case Is > 2432
BeginDate = sDate(54)
Case Is > 2422
BeginDate = sDate(53)
Case Is > 2412
BeginDate = sDate(52)
Case Is > 2402
BeginDate = sDate(51)
Case Is > 2392
BeginDate = sDate(50)
Case Is > 2382
BeginDate = sDate(49)
Case Is > 2372
BeginDate = sDate(48)
Case Is > 2362
BeginDate = sDate(47)
Case Is > 2352
BeginDate = sDate(46)
Case Is > 2342
BeginDate = sDate(45)
Case Is > 2332
BeginDate = sDate(44)
Case Is > 2322
BeginDate = sDate(43)
Case Is > 2312
BeginDate = sDate(42)
Case Is > 2302
BeginDate = sDate(41)
Case Is > 2292
BeginDate = sDate(40)
Case Is > 2282
BeginDate = sDate(39)
Case Is > 2272
BeginDate = sDate(38)
Case Is > 2262
BeginDate = sDate(37)
Case Is > 2252
BeginDate = sDate(36)
Case Is > 2242
BeginDate = sDate(35)
Case Is > 2232
BeginDate = sDate(34)
Case Is > 2222
BeginDate = sDate(33)
Case Is > 2212
BeginDate = sDate(32)
Case Is > 2202
BeginDate = sDate(31)
Case Is > 2192
BeginDate = sDate(30)
Case Is > 2182
BeginDate = sDate(29)
Case Is > 2172
BeginDate = sDate(28)
Case Is > 2162
BeginDate = sDate(27)
Case Is > 2152
BeginDate = sDate(26)
Case Is > 2142
BeginDate = sDate(25)
Case Is > 2132
BeginDate = sDate(24)
Case Is > 2122
BeginDate = sDate(23)
Case Is > 2112
BeginDate = sDate(22)
Case Is > 2102
BeginDate = sDate(21)
Case Is > 2092
BeginDate = sDate(20)
Case Is > 2082
BeginDate = sDate(19)
Case Is > 2072
BeginDate = sDate(18)
Case Is > 2062
BeginDate = sDate(17)
Case Is > 2052
BeginDate = sDate(16)
Case Is > 2042
BeginDate = sDate(15)
Case Is > 2032
BeginDate = sDate(14)
Case Is > 2022
BeginDate = sDate(13)
Case Is > 2012
BeginDate = sDate(12)
Case Is > 2002
BeginDate = sDate(11)
Case Is > 1992
BeginDate = sDate(10)
Case Is > 1982
BeginDate = sDate(9)
Case Is > 1972
BeginDate = sDate(8)
Case Is > 1962
BeginDate = sDate(7)
Case Is > 1952
BeginDate = sDate(6)
Case Is > 1942
BeginDate = sDate(5)
Case Is > 1932
BeginDate = sDate(4)
Case Is > 1922
BeginDate = sDate(3)
Case Is > 1912
BeginDate = sDate(2)
Case Is > 1902
BeginDate = sDate(1)
End Select
'นับวารถึงปีก่อนหน้าปีปัจจุบัน
For i = Year(BeginDate) + 1 To Year(iDate) - 1
DayInYear = LDayInYear(i)
PrevYear = DateAdd("d", DayInYear, BeginDate)
BeginDate = PrevYear
Next i
RDayPrev = DateDiff("d", PrevYear, DateSerial(Year(PrevYear), 12, 31)) 'จำนวนวารที่เหลืออยู่ของปี นับจาก ขึ้น 1 ค่ำเดือน 1
DayOfYear = DateDiff("d", DateSerial(Year(iDate), 1, 1), iDate) 'จำนวนวันของปีที่ถึงวันที่ที่กำหนด
DayFromOne = RDayPrev + DayOfYear + 1 'จำนวนวารจากขึ้น ๑ ค่ำ เดือน ๑ + จำนวนวารที่เหลือในปีถัดไป
NbLDayYear = LDayInYear(Year(iDate)) 'จำนวนวารของปี
'จำแนกชนิดของปีปัจจุบัน
Select Case NbLDayYear
Case 354 'ปีปกติ
RDayLY = RDayPrev + NODIYear(Year(iDate))
DofY = DayFromOne
For j = 1 To 14
ThM = j
Select Case j
Case 1
If DofY <= 29 And DofY > 0 Then Exit For Else DofY = DofY - 29
Case 2
If DofY <= 30 And DofY > 0 Then Exit For Else DofY = DofY - 30
Case 3
If DofY <= 29 And DofY > 0 Then Exit For Else DofY = DofY - 29
Case 4
If DofY <= 30 And DofY > 0 Then Exit For Else DofY = DofY - 30
Case 5
If DofY <= 29 And DofY > 0 Then Exit For Else DofY = DofY - 29
Case 6
If DofY <= 30 And DofY > 0 Then Exit For Else DofY = DofY - 30
Case 7
If DofY <= 29 And DofY > 0 Then Exit For Else DofY = DofY - 29
Case 8
If DofY <= 30 And DofY > 0 Then Exit For Else DofY = DofY - 30
Case 9
If DofY <= 29 And DofY > 0 Then Exit For Else DofY = DofY - 29
Case 10
If DofY <= 30 And DofY > 0 Then Exit For Else DofY = DofY - 30
Case 11
If DofY <= 29 And DofY > 0 Then Exit For Else DofY = DofY - 29
Case 12
If DofY <= 30 And DofY > 0 Then Exit For Else DofY = DofY - 30
Case 13
If DofY <= 29 And DofY > 0 Then Exit For Else DofY = DofY - 29
Case 14
If DofY <= 30 And DofY > 0 Then Exit For Else DofY = DofY - 30
Case Else
End Select
Next
'ช่วงขึ้นปีใหม่ของราชการ
If ThM > 12 Then
ThM = ThM - 12
ThZ = 1
Else
ThZ = 0
End If
If DofY > 15 Then
ThS = "แรม "
DofY = DofY - 15
Else
ThS = "ขึ้น "
End If
THLDate = ThS & DofY & " ค่ำ เดือน " & ThM
Case 355 'ปีอธิกวาร
RDayLY = RDayPrev + NODIYear(Year(iDate))
DofY = DayFromOne
For j = 1 To 14
ThM = j
Select Case j
Case 1
If DofY <= 29 And DofY > 0 Then Exit For Else DofY = DofY - 29
Case 2
If DofY <= 30 And DofY > 0 Then Exit For Else DofY = DofY - 30
Case 3
If DofY <= 29 And DofY > 0 Then Exit For Else DofY = DofY - 29
Case 4
If DofY <= 30 And DofY > 0 Then Exit For Else DofY = DofY - 30
Case 5
If DofY <= 29 And DofY > 0 Then Exit For Else DofY = DofY - 29
Case 6
If DofY <= 30 And DofY > 0 Then Exit For Else DofY = DofY - 30
Case 7
If DofY <= 30 And DofY > 0 Then Exit For Else DofY = DofY - 30
Case 8
If DofY <= 30 And DofY > 0 Then Exit For Else DofY = DofY - 30
Case 9
If DofY <= 29 And DofY > 0 Then Exit For Else DofY = DofY - 29
Case 10
If DofY <= 30 And DofY > 0 Then Exit For Else DofY = DofY - 30
Case 11
If DofY <= 29 And DofY > 0 Then Exit For Else DofY = DofY - 29
Case 12
If DofY <= 30 And DofY > 0 Then Exit For Else DofY = DofY - 30
Case 13
If DofY <= 29 And DofY > 0 Then Exit For Else DofY = DofY - 29
Case 14
If DofY <= 30 And DofY > 0 Then Exit For Else DofY = DofY - 30
Case Else
End Select
Next
If ThM > 12 Then
ThM = ThM - 12
ThZ = 1
Else
ThZ = 0
End If
If DofY > 15 Then
ThS = "แรม "
DofY = DofY - 15
Else
ThS = "ขึ้น "
End If
THLDate = ThS & DofY & " ค่ำ เดือน " & ThM
Case 384 'ปีอธิกมาส
RDayLY = RDayPrev + NODIYear(Year(iDate))
DofY = DayFromOne
For j = 1 To 15
ThM = j
Select Case j
Case 1
If DofY <= 29 And DofY > 0 Then Exit For Else DofY = DofY - 29
Case 2
If DofY <= 30 And DofY > 0 Then Exit For Else DofY = DofY - 30
Case 3
If DofY <= 29 And DofY > 0 Then Exit For Else DofY = DofY - 29
Case 4
If DofY <= 30 And DofY > 0 Then Exit For Else DofY = DofY - 30
Case 5
If DofY <= 29 And DofY > 0 Then Exit For Else DofY = DofY - 29
Case 6
If DofY <= 30 And DofY > 0 Then Exit For Else DofY = DofY - 30
Case 7
If DofY <= 29 And DofY > 0 Then Exit For Else DofY = DofY - 29
Case 8
If DofY <= 30 And DofY > 0 Then Exit For Else DofY = DofY - 30
Case 9
If DofY <= 30 And DofY > 0 Then Exit For Else DofY = DofY - 30
Case 10
If DofY <= 29 And DofY > 0 Then Exit For Else DofY = DofY - 29
Case 11
If DofY <= 30 And DofY > 0 Then Exit For Else DofY = DofY - 30
Case 12
If DofY <= 29 And DofY > 0 Then Exit For Else DofY = DofY - 29
Case 13
If DofY <= 30 And DofY > 0 Then Exit For Else DofY = DofY - 30
Case 14
If DofY <= 29 And DofY > 0 Then Exit For Else DofY = DofY - 29
Case 15
If DofY <= 30 And DofY > 0 Then Exit For Else DofY = DofY - 30
Case Else
End Select
Next
If ThM > 13 Then
ThM = ThM - 13
ThZ = 1
Else
ThZ = 0
End If
Select Case ThM
Case 9
ThM = 88
Case 10
ThM = 9
Case 11
ThM = 10
Case 12
ThM = 11
Case 13
ThM = 12
End Select
If DofY > 15 Then
ThS = "แรม "
DofY = DofY - 15
Else
ThS = "ขึ้น "
End If
THLDate = ThS & DofY & " ค่ำ เดือน " & ThM
End Select
'เปิดใช้เลขไทย ถ้าตัวเลือก ThaiNumber เป็น True
If ThaiNumber = True Then THLDate = W2TH(CStr(THLDate))
'แสดงปีนักษัตร ตามระบบราชการ ถ้าตัวเลือก ThaiZodiac เป็น True
If ThaiZodiac = True Then
If ZOption = False Then
If ThZ = 1 Then
THLDate = THLDate & " ปี" & ThZodiac(Year(iDate) + 1)
Else
THLDate = THLDate & " ปี" & ThZodiac(Year(iDate))
End If
Else
ThH = ThM
If ThH < 5 And ThZ = 0 Then
THLDate = THLDate & " ปี" & ThZodiac(Year(iDate) - 1)
ElseIf ThH < 5 And ThZ = 1 Then
THLDate = THLDate & " ปี" & ThZodiac(Year(iDate))
Else
THLDate = THLDate & " ปี" & ThZodiac(Year(iDate))
End If
End If
End If
'แสดงปีศักราช ถ้าตัวเลือก Era เป็น 1-5
Select Case Era
Case 1
Select Case ThaiNumber
Case True
THLDate = W2TH(THLDate & " พุทธศักราช " & Year(iDate) + 543)
Case False
THLDate = THLDate & " พุทธศักราช " & Year(iDate) + 543
End Select
Case 2
Select Case ThaiNumber
Case True
THLDate = W2TH(THLDate & " จุลศักราช " & Year(iDate) - 638)
Case False
THLDate = THLDate & " จุลศักราช " & Year(iDate) - 638
End Select
Case 3
Select Case ThaiNumber
Case True
THLDate = W2TH(THLDate & " มหาศักราช " & Year(iDate) - 78)
Case False
THLDate = THLDate & " มหาศักราช " & Year(iDate) - 78
End Select
Case 4
Select Case ThaiNumber
Case True
THLDate = W2TH(THLDate & " รัตนโกสินทร์ศก " & Year(iDate) - 1781)
Case False
THLDate = THLDate & " รัตนโกสินทร์ศก " & Year(iDate) - 1781
End Select
Case 5
Select Case ThaiNumber
Case True
THLDate = W2TH(THLDate & " คริสตศักราช " & Year(iDate))
Case False
THLDate = THLDate & " คริสตศักราช " & Year(iDate)
End Select
Case Else
End Select
If Holiday = True Then
THLDate = THLDate & " " & ThLunarHoliday(iDate)
End If
THLDate = Trim(THLDate)
End Function
Function ThZodiac(iYear As Integer, Optional oType As Integer = 1)
'ThZodiac = Thai Zodiac Year Name
'สูตรสำหรับแปลงเลขปี ค.ศ. เป็นชื่อปีนักษัตร
'Copyright 2022 and later by Pongsathorn Sraouthai
'
'oType = Output Type
'1 = Thai
'2 = English
'3 = Number
Dim Zodiac(1 To 3, 1 To 12)
Dim Result
Zodiac(1, 1) = "ชวด"
Zodiac(1, 2) = "ฉลู"
Zodiac(1, 3) = "ขาล"
Zodiac(1, 4) = "เถาะ"
Zodiac(1, 5) = "มะโรง"
Zodiac(1, 6) = "มะเส็ง"
Zodiac(1, 7) = "มะเมีย"
Zodiac(1, 8) = "มะแม"
Zodiac(1, 9) = "วอก"
Zodiac(1, 10) = "ระกา"
Zodiac(1, 11) = "จอ"
Zodiac(1, 12) = "กุน"
Zodiac(2, 1) = "RAT"
Zodiac(2, 2) = "OX"
Zodiac(2, 3) = "TIGER"
Zodiac(2, 4) = "RABBIT"
Zodiac(2, 5) = "DRAGON"
Zodiac(2, 6) = "SNAKE"
Zodiac(2, 7) = "HORSE"
Zodiac(2, 8) = "GOAT"
Zodiac(2, 9) = "MONKEY"
Zodiac(2, 10) = "ROOSTER"
Zodiac(2, 11) = "DOG"
Zodiac(2, 12) = "PIG"
Zodiac(3, 1) = 1
Zodiac(3, 2) = 2
Zodiac(3, 3) = 3
Zodiac(3, 4) = 4
Zodiac(3, 5) = 5
Zodiac(3, 6) = 6
Zodiac(3, 7) = 7
Zodiac(3, 8) = 8
Zodiac(3, 9) = 9
Zodiac(3, 10) = 10
Zodiac(3, 11) = 11
Zodiac(3, 12) = 12
Result = iYear Mod 12
If Result - 3 < 1 Then
Result = Result - 3 + 12
Else
Result = Result - 3
End If
ThZodiac = Zodiac(oType, Result)
End Function
Function W2TH(strInput As String) As String
'สูตรสำหรับแปลงเลขอารบิกเป็นเลขไทย
Dim numberArray
numberArray = Array("0", ChrW(3664), _
"1", ChrW(3665), _
"2", ChrW(3666), _
"3", ChrW(3667), _
"4", ChrW(3668), _
"5", ChrW(3669), _
"6", ChrW(3670), _
"7", ChrW(3671), _
"8", ChrW(3672), _
"9", ChrW(3673))
Dim i As Long
W2TH = strInput
For i = 0 To 18 Step 2
W2TH = Replace(W2TH, numberArray(i), numberArray(i + 1))
Next i
End Function
Function ThLunarHoliday(iDate As Date) As String
'สำหรับแสดงผลวันสำคัญทางจันทรคติ
'
'จำเป็นต้องใช้ฟังชั่น Athikamas และ THLDate
'
If AthikaMas(Year(iDate)) = False Then
Select Case THLDate(iDate)
Case "ขึ้น 15 ค่ำ เดือน 3"
ThLunarHoliday = "วันมาฆบูชา"
Case "ขึ้น 15 ค่ำ เดือน 6"
ThLunarHoliday = "วันวิสาขบูชา"
Case "แรม 8 ค่ำ เดือน 6"
ThLunarHoliday = "วันอัฏฐมีบูชา"
Case "ขึ้น 15 ค่ำ เดือน 8"
ThLunarHoliday = "วันอาสาฬหบูชา"
Case "แรม 1 ค่ำ เดือน 8"
ThLunarHoliday = "วันเข้าพรรษา"
Case "ขึ้น 15 ค่ำ เดือน 11"
ThLunarHoliday = "วันออกพรรษา"
Case "ขึ้น 15 ค่ำ เดือน 12"
ThLunarHoliday = "วันลอยกระทง"
Case Else
ThLunarHoliday = ""
End Select
Else
Select Case THLDate(iDate)
Case "ขึ้น 15 ค่ำ เดือน 4"
ThLunarHoliday = "วันมาฆบูชา"
Case "ขึ้น 15 ค่ำ เดือน 7"
ThLunarHoliday = "วันวิสาขบูชา"
Case "แรม 8 ค่ำ เดือน 7"
ThLunarHoliday = "วันอัฏฐมีบูชา"
Case "ขึ้น 15 ค่ำ เดือน 88"
ThLunarHoliday = "วันอาสาฬหบูชา"
Case "แรม 1 ค่ำ เดือน 88"
ThLunarHoliday = "วันเข้าพรรษา"
Case "ขึ้น 15 ค่ำ เดือน 11"
ThLunarHoliday = "วันออกพรรษา"
Case "ขึ้น 15 ค่ำ เดือน 12"
ThLunarHoliday = "วันลอยกระทง"
Case Else
ThLunarHoliday = ""
End Select
End If
End Function
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment