【Access小品】周而復始 -- 獲取每月各周日期范圍示例

todaynew

　　最近有版友問到統(tǒng)計每月中各周的數(shù)據(jù)問題，這個問題的解決要點是如何獲得每月中各周的日期范圍。而獲得各周的日期范圍的難點，又在于第一周和最后一周可能不是完整的七天。時間的流逝是周而復始的，但由于以月度和周兩個時間度量來計算，就可能造成某一種時間度量（周）在另一種度量（月）的約束下不一定周而復始。注意這里說的不能周而復始的前提是因為另一種度量的約束，也就是說沒有這種約束，依然是周而復始的。

　　前面我們討論周在月中不完全能周而復始的原因并不重要，就本問題而言最重要的是觀察到第一周和最后一周可能不是完整的七天。有了這個對問題的觀察，我們也就有了解決問題的思考方向，由此入手也就不難解決問題。在本示例中主要采用一個自定義的函數(shù)來處理問題，這個自定義函數(shù)大體可以按如下代碼編寫：

Public Function WeekDateArr(ByVal y As Integer, ByVal m As Integer) As Variant
    '功能：返回當前月度中各周的日期范圍
    '參數(shù)：y -- 年度， m -- 月度
    Dim monthday0 As Date, monthday1 As Date
    Dim weekday0 As Date, weekday1 As Date
    Dim Arr() As String
    Dim i As Integer

    monthday0 = DateSerial(y, m, 1)
    monthday1 = DateSerial(y, m + 1, 0)

    '第一周日期范圍
    weekday0 = monthday0
    weekday1 = DateAdd("d", 7 - Weekday(weekday0, vbMonday), weekday0)
    ReDim Preserve Arr(1, 0)
    Arr(0, 0) = weekday0
    Arr(1, 0) = weekday1
    i = 0

    Do While weekday1 < monthday1
        weekday0 = DateAdd("d", 1, weekday1)
        weekday1 = DateAdd("d", 6, weekday0)
        If weekday1 > monthday1 Then weekday1 = monthday1
        i = i + 1
        ReDim Preserve Arr(1, i)
        Arr(0, i) = weekday0
        Arr(1, i) = weekday1
    Loop

    WeekDateArr = Arr
End Function


示例：

視圖：

yanwei82123300

看看這個就是todaynew 老師幫助做的！用處非常大

5988143

老漢的作品一往如故的收藏中~

tmtony

收藏了！

fjh

收藏學習

owen2016

已經(jīng)下載學習，謝謝

YXH_YXH

謝謝分享！�。�