从网上下载到一段公历转农历的自定 义函数,但这个函数有个问题是,参数只能引用单元格,不能直接使用常量,应该如何进行修改,源代码如下- 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,D5200D1"
- Private Const ylMd0 = "初一初二初三初四初五初六初七初八初九初十十一十二十三十四十五" _
- & "十六十七十八十九二十廿一廿二廿三廿四廿五廿六廿七廿八廿九三十 "
- Private Const ylMn0 = "正二三四五六七八九十冬腊"
- Private Const ylTianGan0 = "甲乙丙丁戊已庚辛壬癸"
- Private Const ylDiZhi0 = "子丑寅卯辰巳午未申酉戌亥"
- Private Const ylShu0 = "鼠牛虎兔龙蛇马羊猴鸡狗猪"
- Function NongLi(ByVal strDate As String) As String
- On Error GoTo aErr
- If Not IsDate(strDate) Then Exit Function
- Dim setDate As Date, tYear As Integer, tMonth As Integer, tDay As Integer
- setDate = CDate(strDate)
- tYear = Year(setDate): tMonth = Month(setDate): tDay = Day(setDate)
- If tYear > 2100 Or tYear < 1900 Then Exit Function
- Dim daList() As String * 18, conDate As Date, thisMonths As String
- Dim AddYear As Integer, AddMonth As Integer, AddDay As Integer, getDay As Integer
- Dim YLyear As String, YLShuXing As String
- Dim dd0 As String, mm0 As String, ganzhi(0 To 59) As String * 2
- Dim RunYue As Boolean, RunYue1 As Integer, mDays As Integer, i As Integer
- 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 = tYear
- initYL:
- 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 initYL
- thisMonths = 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 If
- thisMonths = Left(thisMonths, 13)
- For i = 1 To 13
- mDays = 29 + CInt(Mid(thisMonths, i, 1))
- If getDay > mDays Then
- getDay = getDay - mDays
- Else
- If RunYue1 > 0 Then
- If i = RunYue1 + 1 Then RunYue = True
- If i > RunYue1 Then i = i - 1
- End If
- AddMonth = i
- AddDay = getDay
- Exit For
- End If
- Next
- dd0 = Mid(ylMd0, (AddDay - 1) * 2 + 1, 2)
- mm0 = Mid(ylMn0, AddMonth, 1) + "月"
- For i = 0 To 59
- ganzhi(i) = Mid(ylTianGan0, (i Mod 10) + 1, 1) + Mid(ylDiZhi0, (i Mod 12) + 1, 1)
- Next i
- YLyear = ganzhi((AddYear - 4) Mod 60)
- YLShuXing = Mid(ylShu0, ((AddYear - 4) Mod 12) + 1, 1)
- If RunYue Then mm0 = "闰" & mm0
- NongLi = "农历" & YLyear & "(" & YLShuXing & ")年" & mm0 & dd0
- aErr:
- End Function
- Private Function H2B(ByVal strHex As String) As String
- Dim i As Integer, i1 As Integer, tmpV As String
- Const hStr = "0123456789ABCDEF"
- Const bStr = "0000000100100011010001010110011110001001101010111100110111101111"
- tmpV = 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)
- Next
- H2B = H2B & Mid(strHex, 4, 2)
- H2B = H2B & "0" & CStr(Val("&H" & Right(strHex, 2)))
- End Function
复制代码
引用单元格的效果
直接常量的效果
- =NongLi(TEXT("2013/12/24"+10,"e/m/d"))
复制代码这样可以。
|