公司的工厂日历的模块代码，进行修改规整

todaynew

todaynew 老师我要提取日期的目的是将客户订单的需求日期与这个日期做链接目的是：1、看订单落在哪一个月？ ...
yanwei82123300 发表于 2010-10-12 08:12

最后的示例中已经给你写了两个函数，其中mnth函数就是用来返回相应数据的。

Function Calendar(Myyear As Long) As String
'功能：每季度按445周的的工厂日历
'参数：Myyear--财政年度
'示例：Me.日历.RowSource = "月度;首日;末日;" & Calendar(Me.年度.Value)
Dim mydate As Date
Dim str As String
Dim i As Long, j As Long, m
mydate = DateSerial(Myyear - 1, 10, 1)
str = str & 1 & ";" & mydate & ";"
If Weekday(mydate, vbMonday) <> 6 Then
    mydate = DateAdd("d", 21, mydate)
    For j = 1 To 7
        If Weekday(mydate, vbMonday) = 5 Then
                Exit For
        End If
        mydate = DateAdd("d", 1, mydate)
    Next
Else
    mydate = DateAdd("d", 20, mydate)
End If
str = str & mydate & ";"
m = 0
For i = 1 To 4
    For j = 1 To 3
        m = m + 1
        If m = 12 Then Exit For
        If m <> 1 Then
            str = str & m & ";" & DateAdd("d", 1, mydate) & ";"
            If j <> 3 Then
                mydate = DateAdd("d", 28, mydate)
            Else
                mydate = DateAdd("d", 35, mydate)
            End If
            str = str & mydate & ";"
        End If
    Next
    If m = 12 Then Exit For
Next
str = str & m & ";" & DateAdd("d", 1, mydate) & ";" & DateSerial(Myyear, 9, 30)
Calendar = str
End Function

Function mnth(mydate As Date) As Variant
'功能：按日历日期返回财政日历数组
'参数：mydate--日历日期
'示例：
'
'select *,mnth(订单日期)(0) as 财政年,mnth(订单日期)(1) as 财政月,mnth(订单日期)(4) as 周 from 订单表
Dim str As String
Dim myMonth As Long
Dim A
Dim B(5)
Dim date0 As Date, date1 As Date
Dim i As Long
If Month(mydate) >= 10 And Month(mydate) <= 12 Then
    str = Calendar(Year(mydate) + 1)
    B(0) = Year(mydate) + 1
Else
    str = Calendar(Year(mydate))
    B(0) = Year(mydate)
End If
A = Split(str, ";")
For i = 0 To UBound(A, 1) Step 3
    myMonth = A(i)
    date0 = CDate(A(i + 1))
    date1 = CDate(A(i + 2))
    If CDate(mydate) >= date0 And CDate(mydate) <= date1 Then
        B(2) = date0: B(3) = date1
        B(4) = DateDiff("ww", date0, mydate)
        Exit For
    End If
Next
B(1) = myMonth
mnth = B
End Function

yanwei82123300

非常谢谢todaynew 帮助！