楼主
amulee |
Q：如何获取某日期段中包含的节日？
A：如下例，节日有元旦，春节、五一、国庆、店庆等。可以编写自定义函数，代码如下：- Function CHoliday(Start_Date, End_Date)
- Dim d As Object, arrHd, Year1, Year2, Temp, ArrTemp
- Dim Date1, Date2
- Date1 = CDate(Start_Date)
- Date2 = CDate(End_Date)
- If Date2 < Date1 Then
- CHoliday = "#VALUE!"
- Exit Function
- End If
- ReDim arrHd(1 To 5, 1 To 2)
- arrHd(1, 1) = "1-1"
- arrHd(2, 1) = ""
- arrHd(3, 1) = "5-1"
- arrHd(4, 1) = "10-1"
- arrHd(5, 1) = "11-15"
- arrHd(1, 2) = "元旦"
- arrHd(2, 2) = "春节"
- arrHd(3, 2) = "五一"
- arrHd(4, 2) = "国庆"
- arrHd(5, 2) = "店庆"
- Year1 = Year(Date1)
- Year2 = Year(Date2)
- Set d = CreateObject("Scripting.Dictionary")
- For k = Year1 To Year2
- For i = 1 To 5
- If i <> 2 Then
- Temp = CDate(k & "-" & arrHd(i, 1))
- Else
- Temp = CDate(solar(k & "-1-1"))
- End If
- If Date1 <= Temp And Date2 >= Temp Then d(arrHd(i, 2)) = 1
- Next i
- Next
- CHoliday = Join(d.keys)
- End Function
另外需要一个模块添加以下农历转公历的代码:- Type ConvDataA
- leapmonth As Integer
- month(1 To 13) As Integer
- sp_month As Integer 'Solar month of Spring Festival
- sp_day As Integer 'Solar day of Spring Festival
- End Type
- Private Function LunarData(q_year) As ConvDataA
- Dim d As Long
- Dim month(1 To 13) As Integer
- '1901-2100
- LunarCal = Array(&H4AE53, &HA5748, &H5526BD, &HD2650, &HD9544, &H46AAB9, &H56A4D, &H9AD42, &H24AEB6, &H4AE4A, _
- &H6A4DBE, &HA4D52, &HD2546, &H5D52BA, &HB544E, &HD6A43, &H296D37, &H95B4B, &H749BC1, &H49754, _
- &HA4B48, &H5B25BC, &H6A550, &H6D445, &H4ADAB8, &H2B64D, &H95742, &H2497B7, &H4974A, &H664B3E, _
- &HD4A51, &HEA546, &H56D4BA, &H5AD4E, &H2B644, &H393738, &H92E4B, &H7C96BF, &HC9553, &HD4A48, _
- &H6DA53B, &HB554F, &H56A45, &H4AADB9, &H25D4D, &H92D42, &H2C95B6, &HA954A, &H7B4ABD, &H6CA51, _
- &HB5546, &H555ABB, &H4DA4E, &HA5B43, &H352BB8, &H52B4C, &H8A953F, &HE9552, &H6AA48, &H7AD53C, _
- &HAB54F, &H4B645, &H4A5739, &HA574D, &H52642, &H3E9335, &HD9549, &H75AABE, &H56A51, &H96D46, _
- &H54AEBB, &H4AD4F, &HA4D43, &H4D26B7, &HD254B, &H8D52BF, &HB5452, &HB6A47, &H696D3C, &H95B50, _
- &H49B45, &H4A4BB9, &HA4B4D, &HAB25C2, &H6A554, &H6D449, &H6ADA3D, &HAB651, &H93746, &H5497BB, _
- &H4974F, &H64B44, &H36A537, &HEA54A, &H86B2BF, &H5AC53, &HAB647, &H5936BC, &H92E50, &HC9645, _
- &H4D4AB8, &HD4A4C, &HDA541, &H25AA36, &H56A49, &H7AADBD, &H25D52, &H92D47, &H5C95BA, &HA954E, _
- &HB4A43, &H4B5537, &HAD54A, &H955ABF, &H4BA53, &HA5B48, &H652BBC, &H52B50, &HA9345, &H474AB9, _
- &H6AA4C, &HAD541, &H24DAB6, &H4B64A, &H69573D, &HA4E51, &HD2646, &H5E933A, &HD534D, &H5AA43, _
- &H36B537, &H96D4B, &HB4AEBF, &H4AD53, &HA4D48, &H6D25BC, &HD254F, &HD5244, &H5DAA38, &HB5A4C, _
- &H56D41, &H24ADB6, &H49B4A, &H7A4BBE, &HA4B51, &HAA546, &H5B52BA, &H6D24E, &HADA42, &H355B37, _
- &H9374B, &H8497C1, &H49753, &H64B48, &H66A53C, &HEA54F, &H6B244, &H4AB638, &HAAE4C, &H92E42, _
- &H3C9735, &HC9649, &H7D4ABD, &HD4A51, &HDA545, &H55AABA, &H56A4E, &HA6D43, &H452EB7, &H52D4B, _
- &H8A95BF, &HA9553, &HB4A47, &H6B553B, &HAD54F, &H55A45, &H4A5D38, &HA5B4C, &H52B42, &H3A93B6, _
- &H69349, &H7729BD, &H6AA51, &HAD546, &H54DABA, &H4B64E, &HA5743, &H452738, &HD264A, &H8E933E, _
- &HD5252, &HDAA47, &H66B53B, &H56D4F, &H4AE45, &H4A4EB9, &HA4D4C, &HD1541, &H2D92B5, &HD5349)
- startyear = 1901
- ng = LunarCal(q_year - startyear)
- d = &H100000
- LunarData.leapmonth = Int(ng / d)
- ng = ng Mod d
- d = &H80
- mdata = Int(ng / d)
- ng = ng Mod d
- d = &H20
- LunarData.sp_month = Int(ng / d)
- LunarData.sp_day = ng Mod d
- d = &H1000
- i = 1
- Do
- LunarData.month(i) = 29 + Int(mdata / d)
- mdata = mdata Mod d
- If d = 1 Then Exit Do
- d = d / 2
- i = i + 1
- Loop
- If LunarData.leapmonth = 0 Then LunarData.month(i) = 0
- End Function
- Function solar(Lunar_date, Optional IS_lunar_leapmonth As Integer = 0) As String
- Dim a As ConvDataA
- Lunar_date = Split(Lunar_date, "-")
- s_year = Lunar_date(0)
- For Each C In Lunar_date
- If C = "L" Then IS_lunar_leapmonth = 1
- Next
- a = LunarData(s_year)
- sp_date = DateSerial(s_year, a.sp_month, a.sp_day)
- If Lunar_date(1) <> a.leapmonth Then IS_lunar_leapmonth = 0
- x = Lunar_date(2)
- tm = Lunar_date(1) + IS_lunar_leapmonth - 1
- For i = 1 To tm
- x = x + a.month(i)
- If i = a.leapmonth And IS_lunar_leapmonth = 0 Then
- x = x + a.month(13)
- End If
- Next
- s_date = sp_date + x - 1
- solar = s_date
- End Function
函数用法：- =CHoliday(起始日期,终止日期)
 获取包含的节假日.rar
|