陽歷日期轉農歷日期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 = "鼠牛虎免龍蛇馬羊猴雞狗豬"
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
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(25) = 2349
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(69) = 330031
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
'原创：互联网
'修正：阿勇 2005/1/12，云南省巍山彝族回族自治县财政局 黄成武（[email protected]）good Luck!