阳历日期转农历日期

陽歷日期轉農歷日期
Option Explicit
Dim TianGan As String
Dim DiZhi As String
Dim ShuXiang As String
Dim TianGanx As String
Dim DiZhix As String
Dim ShuXiangx As String
Dim NongliData(99) As Double
Dim CurTime As Date
Dim curYear, curMonth, curDay
Dim I, M, N, K, isEnd, Bit, TheDate Private Sub Form_Load()
CurTime = Now()
TianGanx = "甲乙丙丁戊已庚辛壬癸"
DiZhix = "子丑寅卯辰已午未申酉戊亥"
ShuXiangx = "鼠牛虎免龍蛇馬羊猴雞狗豬"
NongliData(0) = 2635
NongliData(1) = 333387
NongliData(2) = 1701
NongliData(3) = 1748
NongliData(4) = 267701
NongliData(5) = 694
NongliData(6) = 2391
NongliData(7) = 133423
NongliData(8) = 1175
NongliData(9) = 396438
NongliData(10) = 3402
NongliData(11) = 3749
NongliData(12) = 331177
NongliData(13) = 1453
NongliData(14) = 694
NongliData(15) = 201326
NongliData(16) = 2350
NongliData(17) = 465197
NongliData(18) = 3221
NongliData(19) = 3402
NongliData(20) = 400202
NongliData(21) = 2901
NongliData(22) = 1386
NongliData(23) = 267611
NongliData(24) = 605
NongliData(26) = 137515 NongliData(27) = 2709 NongliData(28) = 464533 NongliData(29) = 1738 NongliData(30) = 2901 NongliData(31) = 330421 NongliData(32) = 1242 NongliData(33) = 2651 NongliData(34) = 199255 NongliData(35) = 1323 NongliData(36) = 529706 NongliData(37) = 3733 NongliData(38) = 1706 NongliData(39) = 398762 NongliData(40) = 2741 NongliData(41) = 1206 NongliData(42) = 267438 NongliData(43) = 2647 NongliData(44) = 1318 NongliData(45) = 204070 NongliData(46) = 3477 NongliData(47) = 461653 NongliData(48) = 1386 NongliData(49) = 2413 NongliData(50) = 330077 NongliData(51) = 1197 NongliData(52) = 2637 NongliData(53) = 268877 NongliData(54) = 3365 NongliData(55) = 531109 NongliData(56) = 2900 NongliData(57) = 2922 NongliData(58) = 398042 NongliData(59) = 2395 NongliData(60) = 1179 NongliData(61) = 267415 NongliData(62) = 2635 NongliData(63) = 661067 NongliData(64) = 1701 NongliData(65) = 1748 NongliData(66) = 398772 NongliData(67) = 2742 NongliData(68) = 2391
NongliData(70) = 1175
NongliData(71) = 1611
NongliData(72) = 200010
NongliData(73) = 3749
NongliData(74) = 527717
NongliData(75) = 1452
NongliData(76) = 2742
NongliData(77) = 332397
NongliData(78) = 2350
NongliData(79) = 3222
NongliData(80) = 268949
NongliData(81) = 3402
NongliData(82) = 3493
NongliData(83) = 133973
NongliData(84) = 1386
NongliData(85) = 464219
NongliData(86) = 605
NongliData(87) = 2349
NongliData(88) = 334123
NongliData(89) = 2709
NongliData(90) = 2890
NongliData(91) = 267946
NongliData(92) = 2773
NongliData(93) = 592565
NongliData(94) = 1210
NongliData(95) = 2651
NongliData(96) = 395863
NongliData(97) = 1323
NongliData(98) = 2707
NongliData(99) = 265877
curYear = Year(CurTime)
curMonth = Month(CurTime)
curDay = Day(CurTime)
TheDate = DateDiff( "d ", "1921/2/8 ", Date) + 1
isEnd = 0: M = 0
Do
If NongliData(M) < 4095 Then K = 11 Else K = 12 N = K
Do While N > = 0
Bit = NongliData(M)
For I = 1 To N Step 1
Bit = Int(Bit / 2)
Next
Bit = Bit Mod 2
If (TheDate <= 29 + Bit) Then
isEnd = 1
Exit Do
End If
TheDate = TheDate - 29 - Bit
N = N - 1
Loop
If (isEnd = 1) Then Exit Do
M = M + 1
Loop
curYear = 1921 + M
curMonth = K - N + 1
curDay = TheDate
If K = 12 Then
If curMonth = Int(NongliData(M) / 65536) + 1 Then
curMonth = 1 - curMonth
ElseIf (curMonth > (Int(NongliData(M) / 65536) + 1)) Then curMonth = curMonth - 1
End If
End If
'獲得NongLi值
TianGan = Mid(TianGanx, (((curYear - 4) Mod 60) Mod 10) + 1, 1)
DiZhi = Mid(DiZhix, (((curYear - 4) Mod 60) Mod 12) + 1, 1) ShuXiang = Mid(ShuXiangx, (((curYear - 4) Mod 60) Mod 12) + 1 , 1)
If curMonth < 1 Then curMonth = curMonth * -1
Application.StatusBar = "農歷: " & curMonth & "月" & curDay
End Sub。