以下是一个经典的公农历转换的例子,只是其中的农历信息只提供了1921-2020年共100年的数据,谁能提供更多的农历信息,或者告知其农历信息是如何表达的。如NongliData(82)代表的是2003年的农历数据。3493这个值是怎么算出来的。分不够可以再加。Public WeekName(7), MonthAdd(11), NongliData(99), TianGan(9), DiZhi(11), ShuXiang(11), DayName(30), MonName(12)
Public curTime, curYear, curMonth, curDay, curWeekday
Public GongliStr, WeekdayStr, NongliStr, NongliDayStr
Public i, m, n, k, isEnd, bit, TheDate
Function GetLunarCalendar()'获取当前系统时间
curTime = Now()'星期名
WeekName(0) = " * "
WeekName(1) = "星期日"
WeekName(2) = "星期一"
WeekName(3) = "星期二"
WeekName(4) = "星期三"
WeekName(5) = "星期四"
WeekName(6) = "星期五"
WeekName(7) = "星期六"'天干名称
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) = "亥"'属相名称
ShuXiang(0) = "鼠"
ShuXiang(1) = "牛"
ShuXiang(2) = "虎"
ShuXiang(3) = "兔"
ShuXiang(4) = "龙"
ShuXiang(5) = "蛇"
ShuXiang(6) = "马"
ShuXiang(7) = "羊"
ShuXiang(8) = "猴"
ShuXiang(9) = "鸡"
ShuXiang(10) = "狗"
ShuXiang(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'生成当前公历星期 ==> WeekdayStr
curWeekday = Weekday(curTime)
WeekdayStr = WeekName(curWeekday)'计算到初始时间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 = 0Do
    If (NongliData(m) < 4095) Then
        k = 11
    Else
        k = 12
    End If    n = k
    Do
        If (n < 0) Then
            Exit Do
        End If    '获取NongliData(m)的第n个二进制位的值
    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
LoopcurYear = 1921 + m
curMonth = k - n + 1
curDay = TheDateIf (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 IfEnd If'生成农历天干、地支、属相 ==> NongliStr
NongliStr = "农历" & TianGan(((curYear - 4) Mod 60) Mod 10) & DiZhi(((curYear - 4) Mod 60) Mod 12) & "年"
NongliStr = NongliStr & "(" & ShuXiang(((curYear - 4) Mod 60) Mod 12) & ")"'生成农历月、日 ==> NongliDayStr
If (curMonth < 1) Then
    NongliDayStr = "闰" & MonName(-1 * curMonth)
Else
    NongliDayStr = MonName(curMonth)
End If
'NongliDayStr = NongliDayStrNongliDayStr = NongliDayStr & DayName(curDay)
MsgBox NongliStr & NongliDayStrEnd Function

解决方案 »

  1.   

    一个关于VB的农历算法-转自CSDN'日期数据定义方法如下
    '前12个字节代表1-12月为大月或是小月,1为大月30天,0为小月29天,
    '第13位为闰月的情况,1为大月30天,0为小月29天,第14位为闰月的月
    '份,如果不是闰月为0,否则给出月份,10、11、12分别用A、B、C来表
    '示,即使用16进制。最后4位为当年家农历新年-即农历1月1日所在公历
    '的日期,如0131代表1月31日。
    'GetYLDate函数使用方式如下tYear为要输入的年,tMonth为月,tDay为
    '日期,YLyear是返回值,返加农历的年份,如甲子年,YLShuXing返回
    '的是属象,如鼠。IsGetGl是设置是不是通过农历取公历值,如果是,
    '前三个返回相应的公历日期,而且返回值是一个公历日期。Function GetYLDate(tYear As Integer, tMonth As Integer, tDay As Integer, _
    YLyear As String, YLShuXing As String, _
    Optional IsGetGl As Boolean) As StringOn Error Resume Next
    Dim daList(1900 To 2011) As String * 18
    Dim conDate As Date, setDate As Date
    Dim AddMonth As Integer, AddDay As Integer, AddYear As Integer, getDay As Integer
    Dim RunYue As Boolean
    If tYear > 2010 Or tYear < 1901 Then Exit Function '如果不是有效有日期,退出
    '1900 to 1909
    daList(1900) = "010010110110180131"
    daList(1901) = "010010101110000219"
    daList(1902) = "101001010111000208"
    daList(1903) = "010100100110150129"
    daList(1904) = "110100100110000216"
    daList(1905) = "110110010101000204"
    daList(1906) = "011010101010140125"
    daList(1907) = "010101101010000213"
    daList(1908) = "100110101101000202"
    daList(1909) = "010010101110120122"
    daList(1910) = "010010101110000210"
    daList(1911) = "101001001101160130"
    daList(1912) = "101001001101000218"
    daList(1913) = "110100100101000206"
    daList(1914) = "110101010100150126"
    daList(1915) = "101101010101000214"
    daList(1916) = "010101101010000204"
    daList(1917) = "100101101101020123"
    daList(1918) = "100101011011000211"
    daList(1919) = "010010011011170201"
    daList(1920) = "010010011011000220"
    daList(1921) = "101001001011000208"
    daList(1922) = "101100100101150128"
    daList(1923) = "011010100101000216"
    daList(1924) = "011011010100000205"
    daList(1925) = "101011011010140124"
    daList(1926) = "001010110110000213"
    daList(1927) = "100101010111000202"
    daList(1928) = "010010010111120123"
    daList(1929) = "010010010111000210"
    daList(1930) = "011001001011060130"
    daList(1931) = "110101001010000217"
    daList(1932) = "111010100101000206"
    daList(1933) = "011011010100150126"
    daList(1934) = "010110101101000214"
    daList(1935) = "001010110110000204"
    daList(1936) = "100100110111030124"
    daList(1937) = "100100101110000211"
    daList(1938) = "110010010110170131"
    daList(1939) = "110010010101000219"
    daList(1940) = "110101001010000208"
    daList(1941) = "110110100101060127"
    daList(1942) = "101101010101000215"
    daList(1943) = "010101101010000205"
    daList(1944) = "101010101101140125"
    daList(1945) = "001001011101000213"
    daList(1946) = "100100101101000202"
    daList(1947) = "110010010101120122"
    daList(1948) = "101010010101000210"
    daList(1949) = "101101001010170129"
    daList(1950) = "011011001010000217"
    daList(1951) = "101101010101000206"
    daList(1952) = "010101011010150127"
    daList(1953) = "010011011010000214"
    daList(1954) = "101001011011000203"
    daList(1955) = "010100101011130124"
    daList(1956) = "010100101011000212"
    daList(1957) = "101010010101080131"
    daList(1958) = "111010010101000218"
    daList(1959) = "011010101010000208"
    daList(1960) = "101011010101060128"
    daList(1961) = "101010110101000215"
    daList(1962) = "010010110110000205"
    daList(1963) = "101001010111040125"
    daList(1964) = "101001010111000213"
    daList(1965) = "010100100110000202"
    daList(1966) = "111010010011030121"
    daList(1967) = "110110010101000209"
    daList(1968) = "010110101010170130"
    daList(1969) = "010101101010000217"
    daList(1970) = "100101101101000206"
    daList(1971) = "010010101110150127"
    daList(1972) = "010010101101000215"
    daList(1973) = "101001001101000203"
    daList(1974) = "110100100110140123"
    daList(1975) = "110100100101000211"
    daList(1976) = "110101010010180131"
    daList(1977) = "101101010100000218"
    daList(1978) = "101101101010000207"
    daList(1979) = "100101101101060128"
    daList(1980) = "100101011011000216"
    daList(1981) = "010010011011000205"
    daList(1982) = "101001001011140125"
    daList(1983) = "101001001011000213"
    daList(1984) = "1011001001011A0202"
    daList(1985) = "011010100101000220"
    daList(1986) = "011011010100000209"
    daList(1987) = "101011011010060129"
    daList(1988) = "101010110110000217"
    daList(1989) = "100100110111000206"
    daList(1990) = "010010010111150127"
    daList(1991) = "010010010111000215"
    daList(1992) = "011001001011000204"
    daList(1993) = "011010100101030123"
    daList(1994) = "111010100101000210"
    daList(1995) = "011010110010180131"
    daList(1996) = "010110101100000219"
    daList(1997) = "101010110110000207"
    daList(1998) = "100100110110150128"
    daList(1999) = "100100101110000216"
    daList(2000) = "110010010110000205"
    daList(2001) = "110101001010140124"
    daList(2002) = "110101001010000212"
    daList(2003) = "110110100101000201"
    daList(2004) = "010110101010120122"
    daList(2005) = "010101101010000209"
    daList(2006) = "101010101101170129"
    daList(2007) = "001001011101000218"
    daList(2008) = "100100101101000207"
    daList(2009) = "110010010101150126"
    daList(2010) = "101010010101000214"
    daList(2011) = "101101001010000214"
    AddYear = tYear
    RunYue = FalseIf IsGetGl Then
    AddMonth = Val(Mid(daList(AddYear), 15, 2))
    AddDay = Val(Mid(daList(AddYear), 17, 2))
    conDate = DateSerial(AddYear, AddMonth, AddDay)
    AddDay = tDay
    For i = 1 To tMonth - 1
    AddDay = AddDay + 29 + Val(Mid(daList(tYear), i, 1))
    Next i
    'MsgBox DateDiff("d", conDate, Date)
    setDate = DateAdd("d", AddDay - 1, conDate)
    GetYLDate = setDate
    tYear = Year(setDate)
    tMonth = Month(setDate)
    tDay = Day(setDate)
    Exit Function
    End If
    CHUSHIHUA:
    AddMonth = Val(Mid(daList(AddYear), 15, 2))
    AddDay = Val(Mid(daList(AddYear), 17, 2))
    conDate = DateSerial(AddYear, AddMonth, AddDay)
    setDate = DateSerial(tYear, tMonth, tDay)
    getDay = DateDiff("d", conDate, setDate)
    If getDay < 0 Then AddYear = AddYear - 1: GoTo CHUSHIHUA
    ' addday = NearDay
    AddDay = 1: AddMonth = 1
    For i = 1 To getDay
    AddDay = AddDay + 1
    If AddDay = 30 + Mid(daList(AddYear), AddMonth, 1) Or (RunYue And AddDay = 30 + Mid(daList(AddYear), 13, 1)) Then
    If RunYue = False And AddMonth = Val("&H" & Mid(daList(AddYear), 14, 1)) Then
    RunYue = True
    Else
    RunYue = False
    AddMonth = AddMonth + 1
    End If
    AddDay = 1
    End IfNextmd$ = "初一初二初三初四初五初六初七初八初九初十十一十二十三十四十五十六十七十八十九二十廿一廿二廿三廿四廿五廿六廿七廿八廿九三十"
    dd$ = Mid(md$, (AddDay - 1) * 2 + 1, 2)
    mm$ = Mid("正二三四五六七八九十寒腊", AddMonth, 1) + "月"
    YouGetDate = DateSerial(AddYear, AddMonth, AddDay)
    tiangan$ = "甲乙丙丁戊已庚辛壬癸"
    dizhi$ = "子丑寅卯辰巳午未申酉戌亥"
    Dim ganzhi(0 To 59) As String * 2
    For i = 0 To 59
    ganzhi(i) = Mid(tiangan$, (i Mod 10) + 1, 1) + Mid(dizhi$, (i Mod 12) + 1, 1)
    'ff$ = ff$ + ganzhi(i)
    Next i
    'MsgBox ff$, , Len(ff$)
    YLyear = ganzhi((AddYear - 4) Mod 60)
    shu$ = "鼠牛虎兔龙蛇马羊猴鸡狗猪"
    YLShuXing = Mid(shu$, ((AddYear - 4) Mod 12) + 1, 1)
    If RunYue Then mm$ = "闰" + mm$GetYLDate = mm$ + dd$End Function
      

  2.   

    rainstormmaster(rainstormmaster) 说的对。1 保存一个甲子年做年份基准。以后年份减去基准年再mod 60,可以推算出它的干支。当然也可以预存干支顺序,然后用查表法。2 保存一个19年的阴阳历日期对照表。以后年份减去日期基准年再mod 19,然后在对照表中查日期。(原理是农历19年7闰法,使得每19年一个回归)