最近有版友问到统计每月中各周的数据问题，这个问题的解决要点是如何获得每月中各周的日期范围。而获得各周的日期范围的难点，又在于第一周和最后一周可能不是完整的七天。时间的流逝是周而复始的，但由于以月度和周两个时间度量来计算，就可能造成某一种时间度量（周）在另一种度量（月）的约束下不一定周而复始。注意这里说的不能周而复始的前提是因为另一种度量的约束，也就是说没有这种约束，依然是周而复始的。

　　前面我们讨论周在月中不完全能周而复始的原因并不重要，就本问题而言最重要的是观察到第一周和最后一周可能不是完整的七天。有了这个对问题的观察，我们也就有了解决问题的思考方向，由此入手也就不难解决问题。在本示例中主要采用一个自定义的函数来处理问题，这个自定义函数大体可以按如下代码编写：

Public Function WeekDateArr(ByVal y As Integer, ByVal m As Integer) As Variant
    '功能：返回当前月度中各周的日期范围
    '参数：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
 

示   例：

点击下载此附件
 

视   图：