这个是有计算方法的，只要你有计算公式我就可以计算出来的。但是前提你要有计算公式才行。公历转农历模块// 农历数据定义 //先以 H2B 函数还原成长度为 18 的字符串，其定义如下：前12个字节代表1-12月：1为大月，0为小月；压缩成十六进制(1-3位)第13位为闰月的情况，1为大月30天，0为小月29天；(4位)第14位为闰月的月份，如果不是闰月为0，否则给出月份(5位)最后4位为当年农历新年的公历日期，如0131代表1月31日；当作数值转十六进制(6-7位)农历常量(1899~2100，共202年）Private Const ylData = AB500D2,4BD0883, _ 4AE00DB,A5700D0,54D0581,D2600D8,D9500CC,655147D,56A00D5,9AD00CA,55D027A,4AE00D2, _ A5B0682,A4D00DA,D2500CE,D25157E,B5500D6,56A00CC,ADA027B,95B00D3,49717C9,49B00DC, _ A4B00D0,B4B0580,6A500D8,6D400CD,AB5147C,2B600D5,95700CA,52F027B,49700D2,6560682, _ D4A00D9,EA500CE,6A9157E,5AD00D6,2B600CC,86E137C,92E00D3,C8D1783,C9500DB,D4A00D0, _ D8A167F,B5500D7,56A00CD,A5B147D,25D00D5,92D00CA,D2B027A,A9500D2,B550781,6CA00D9, _ B5500CE,535157F,4DA00D6,A5B00CB,457037C,52B00D4,A9A0883,E9500DA,6AA00D0,AEA0680, _ AB500D7,4B600CD,AAE047D,A5700D5,52600CA,F260379,D9500D1,5B50782,56A00D9,96D00CE, _ 4DD057F,4AD00D7,A4D00CB,D4D047B,D2500D3,D550883,B5400DA,B6A00CF,95A1680,95B00D8, _ 49B00CD,A97047D,A4B00D5,B270ACA,6A500DC,6D400D1,AF40681,AB600D9,93700CE,4AF057F, _ 49700D7,64B00CC,74A037B,EA500D2,6B50883,5AC00DB,AB600CF,96D0580,92E00D8,C9600CD, _ D95047C,D4A00D4,DA500C9,755027A,56A00D1,ABB0781,25D00DA,92D00CF,CAB057E,A9500D6, _ B4A00CB,BAA047B,B5500D2,55D0983,4BA00DB,A5B00D0,5171680,52B00D8,A9300CD,795047D, _ 6AA00D4,AD500C9,5B5027A,4B600D2,96E0681,A4E00D9,D2600CE,EA6057E,D5300D5,5AA00CB, _ 76A037B,96D00D3,4AB0B83,4AD00DB,A4D00D0,D0B1680,D2500D7,D5200CC,DD4057C,B5A00D4, _ 56D00C9,55B027A,49B00D2,A570782,A4B00D9,AA500CE,B25157E,6D200D6,ADA00CA,4B6137B, _ 93700D3,49F08C9,49700DB,64B00D0,68A1680,EA500D7,6AA00CC,A6C147C,AAE00D4,92E00CA, _ D2E0379,C9600D1,D550781,D4A00D9,DA400CD,5D5057E,56A00D6,A6C00CB,55D047B,52D00D3, _ A9B0883,A9500DB,B4A00CF,B6A067F,AD500D7,55A00CD,ABA047C,A5A00D4,52B00CA,B27037A, _ 69300D1,7330781,6AA00D9,AD500CE,4B5157E,4B600D6,A5700CB,54E047C,D1600D2,E960882, _ D5200DA,DAA00CF,6AA167F,56D00D7,4AE00CD,A9D047D,A2D00D4,D1500C9,F250279,D5200D1Private Const ylMd0 = 初一初二初三初四初五初六初七初八初九初十十一十二十三十四十五 _ 十六十七十八十九二十廿一廿二廿三廿四廿五廿六廿七廿八廿九三十 Private Const ylMn0 = 正二三四五六七八九十冬腊Private Const ylTianGan0 = 甲乙丙丁戊已庚辛壬癸Private Const ylDiZhi0 = 子丑寅卯辰巳午未申酉戌亥Private Const ylShu0 = 鼠牛虎兔龙蛇马羊猴鸡狗猪公历日期转农历Function GetYLDate(ByVal strDate As String) As StringOn Error GoTo aErrIf Not IsDate(strDate) Then Exit FunctionDim setDate As Date, tYear As Integer, tMonth As Integer, tDay As IntegersetDate = CDate(strDate)tYear = Year(setDate): tMonth = Month(setDate): tDay = Day(setDate)如果不是有效有日期，退出If tYear 2100 Or tYear 1900 Then Exit FunctionDim daList() As String * 18, conDate As Date, thisMonths As StringDim AddYear As Integer, AddMonth As Integer, AddDay As Integer, getDay As IntegerDim YLyear As String, YLShuXing As StringDim dd0 As String, mm0 As String, ganzhi(0 To 59) As String * 2Dim RunYue As Boolean, RunYue1 As Integer, mDays As Integer, i As Integer加载2年内的农历数据ReDim daList(tYear - 1 To tYear)daList(tYear - 1) = H2B(Mid(ylData, (tYear - 1900) * 8 + 1, 7))daList(tYear) = H2B(Mid(ylData, (tYear - 1900 + 1) * 8 + 1, 7))AddYear = tYearinitYL:AddMonth = CInt(Mid(daList(AddYear), 15, 2))AddDay = CInt(Mid(daList(AddYear), 17, 2))conDate = DateSerial(AddYear, AddMonth, AddDay) 农历新年日期getDay = DateDiff(d, conDate, setDate) + 1 相差天数If getDay 1 Then AddYear = AddYear - 1: GoTo initYLthisMonths = Left(daList(AddYear), 14)RunYue1 = Val(H Right(thisMonths, 1)) 闰月月份If RunYue1 0 Then 有闰月thisMonths = Left(thisMonths, RunYue1) Mid(thisMonths, 13, 1) Mid(thisMonths, RunYue1 + 1)End IfthisMonths = Left(thisMonths, 13)For i = 1 To 13 计算天数mDays = 29 + CInt(Mid(thisMonths, i, 1))If getDay mDays ThengetDay = getDay - mDaysElseIf RunYue1 0 ThenIf i = RunYue1 + 1 Then RunYue = TrueIf i RunYue1 Then i = i - 1End IfAddMonth = iAddDay = getDayExit ForEnd IfNextdd0 = Mid(ylMd0, (AddDay - 1) * 2 + 1, 2)mm0 = Mid(ylMn0, AddMonth, 1) + 月For i = 0 To 59ganzhi(i) = Mid(ylTianGan0, (i Mod 10) + 1, 1) + Mid(ylDiZhi0, (i Mod 12) + 1, 1)Next iYLyear = ganzhi((AddYear - 4) Mod 60)YLShuXing = Mid(ylShu0, ((AddYear - 4) Mod 12) + 1, 1)If RunYue Then mm0 = 闰 mm0GetYLDate = 农历 YLyear ( YLShuXing )年 mm0 dd0aErr:End Function农历转公历日期secondMonth 为真，则天示当 tMonth 是闰月时，取第二个月Function GetDate(ByVal tYear As Integer, tMonth As Integer, tDay As Integer, Optional secondMonth As Boolean = False) As StringOn Error GoTo aErrIf tYear 2100 Or tYear 1899 Or tMonth 12 Or tMonth 1 Or tDay 30 Or tDay 1 Then Exit FunctionDim thisMonths As String, ylNewYear As Date, toMonth As IntegerDim mDays As Integer, RunYue1 As Integer, i As IntegerthisMonths = H2B(Mid(ylData, (tYear - 1899) * 8 + 1, 7))If tDay 29 + CInt(Mid(thisMonths, tMonth, 1)) Then Exit FunctionylNewYear = DateSerial(tYear, CInt(Mid(thisMonths, 15, 2)), CInt(Mid(thisMonths, 17, 2))) 农历新年日期thisMonths = Left(thisMonths, 14)RunYue1 = Val(H Right(thisMonths, 1)) 闰月月份toMonth = tMonth - 1If RunYue1 0 Then 有闰月thisMonths = Left(thisMonths, RunYue1) Mid(thisMonths, 13, 1) Mid(thisMonths, RunYue1 + 1)If tMonth RunYue1 Or (secondMonth And tMonth = RunYue1) Then toMonth = tMonthEnd IfthisMonths = Left(thisMonths, 13)mDays = 0For i = 1 To toMonthmDays = mDays + 29 + CInt(Mid(thisMonths, i, 1))NextmDays = mDays + tDayGetDate = ylNewYear + mDays - 1aErr:End Function将压缩的阴历字符还原Private Function H2B(ByVal strHex As String) As StringDim i As Integer, i1 As Integer, tmpV As StringConst hStr = 0123456789ABCDEFConst bStr = 0000000100100011010001010110011110001001101010111100110111101111tmpV = UCase(Left(strHex, 3))十六进制转二进制For i = 1 To Len(tmpV)i1 = InStr(hStr, Mid(tmpV, i, 1))H2B = H2B Mid(bStr, (i1 - 1) * 4 + 1, 4)NextH2B = H2B Mid(strHex, 4, 2)十六进制转十进制H2B = H2B 0 CStr(Val(H Right(strHex, 2)))End FunctionPrivate Sub Command1_Click()Label1.Caption = GetYLDate(Text1.Text)End Sub 做APP，支持

• 八字
• 生辰八字

我想要一个计算生辰八字的vb语言源码