如何得到，当天农历

Question

如果转换日期为当天的，农历

Answer 1

网上的代码，不懂，但管用，text1.Text = GetNongLi(Date)调用Public Function GetNongLi(Gongli As Date) As String '农历日期
  Dim MonthAdd(11), NongliData(99), TianGan(9), DiZhi(11), DayName(30), MonName(12)
  Dim curTime, curYear, curMonth, curDay
  Dim GongliStr, NongliStr, NongliDayStr
  Dim i, m, n, k, isEnd, bit, TheDate
  curTime = Gongli
  TianGan(0) = "甲"
  TianGan(1) = "乙"
  TianGan(2) = "丙"
  TianGan(3) = "丁"
  TianGan(4) = "戊"
  TianGan(5) = "己"
  TianGan(6) = "庚"
  TianGan(7) = "辛"
  TianGan(8) = "壬"
  TianGan(9) = "癸"
  DiZhi(0) = "子"
  DiZhi(1) = "丑"
  DiZhi(2) = "寅"
  DiZhi(3) = "卯"
  DiZhi(4) = "辰"
  DiZhi(5) = "巳"
  DiZhi(6) = "午"
  DiZhi(7) = "未"
  DiZhi(8) = "申"
  DiZhi(9) = "酉"
  DiZhi(10) = "戌"
  DiZhi(11) = "亥"
  DayName(0) = "*"
  DayName(1) = "初一"
  DayName(2) = "初二"
  DayName(3) = "初三"
  DayName(4) = "初四"
  DayName(5) = "初五"
  DayName(6) = "初六"
  DayName(7) = "初七"
  DayName(8) = "初八"
  DayName(9) = "初九"
  DayName(10) = "初十"
  DayName(11) = "十一"
  DayName(12) = "十二"
  DayName(13) = "十三"
  DayName(14) = "十四"
  DayName(15) = "十五"
  DayName(16) = "十六"
  DayName(17) = "十七"
  DayName(18) = "十八"
  DayName(19) = "十九"
  DayName(20) = "二十"
  DayName(21) = "廿一"
  DayName(22) = "廿二"
  DayName(23) = "廿三"
  DayName(24) = "廿四"
  DayName(25) = "廿五"
  DayName(26) = "廿六"
  DayName(27) = "廿七"
  DayName(28) = "廿八"
  DayName(29) = "廿九"
  DayName(30) = "三十"
  MonName(0) = "*"
  MonName(1) = "正"
  MonName(2) = "二"
  MonName(3) = "三"
  MonName(4) = "四"
  MonName(5) = "五"
  MonName(6) = "六"
  MonName(7) = "七"
  MonName(8) = "八"
  MonName(9) = "九"
  MonName(10) = "十"
  MonName(11) = "十一"
  MonName(12) = "腊"
'公历每月前面的天数
  MonthAdd(0) = 0
  MonthAdd(1) = 31
  MonthAdd(2) = 59
  MonthAdd(3) = 90
  MonthAdd(4) = 120
  MonthAdd(5) = 151
  MonthAdd(6) = 181
  MonthAdd(7) = 212
  MonthAdd(8) = 243
  MonthAdd(9) = 273
  MonthAdd(10) = 304
  MonthAdd(11) = 334
'农历数据
  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
'生成当前公历年、月、日 ==> GongliStr
  curYear = Year(curTime)
  curMonth = Month(curTime)
  curDay = Day(curTime)
  GongliStr = curYear & "年"
  If (curMonth < 10) Then
     GongliStr = GongliStr & "0" & curMonth & "月"
  Else
     GongliStr = GongliStr & curMonth & "月"
  End If
  If (curDay < 10) Then
     GongliStr = GongliStr & "0" & curDay & "日"
  Else
    GongliStr = GongliStr & curDay & "日"
  End If
'计算到初始时间1921年2月8日的天数：1921-2-8(正月初一)
  TheDate = (curYear - 1921) * 365 + Int((curYear - 1921) / 4) + curDay + MonthAdd(curMonth - 1) - 38
  If ((curYear Mod 4) = 0 And curMonth > 2) Then
      TheDate = TheDate + 1
  End If
'计算农历天干、地支、月、日
  isEnd = 0
  m = 0
  Do
    If (NongliData(m) < 4095) Then
        k = 11
    Else
        k = 12
    End If
    n = k
    Do
      If (n < 0) Then
        Exit Do
      End If
      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
    End If
    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
  NongliStr = TianGan(((curYear - 4) Mod 60) Mod 10) & DiZhi(((curYear - 4) Mod 60) Mod 12) & "年"
 
  If (curMonth < 1) Then
    NongliDayStr = "闰" & MonName(-1 * curMonth)
  Else
    NongliDayStr = MonName(curMonth)
  End If
  NongliDayStr = NongliDayStr & "月"
  NongliDayStr = NongliDayStr & DayName(curDay)
  GetNongLi = NongliStr & NongliDayStr
End Function

Answer 2

非常感谢lwmwork提供的代码。我找了好久才在这里找到了。真是踏破铁鞋无觅处，得来全不费工夫。再次感谢lwmwor在中国农历网上有专门介绍天文历法的知识，只是整不明白。只好作罢，中国农历网上有关于计算黄道赤道的知识