最近有版友问到统计每月中各周的数据问题，这个问题的解决要点是如何获得每月中各周的日期范围。而获得各周的日期范围的难点，又在于第一周和最后一周可能不是完整的七天。时间的流逝是周而复始的，但由于以月度和周两个时间度量来计算，就可能造成某一种时间度量（周）在另一种度量（月）的约束下不一定周而复始。注意这里说的不能周而复始的前提是因为另一种度量的约束，也就是说没有这种约束，依然是周而复始的。
前面我们讨论周在月中不完全能周而复始的原因并不重要，就本问题而言最重要的是观察到第一周和最后一周可能不是完整的七天。有了这个对问题的观察，我们也就有了解决问题的思考方向，由此入手也就不难解决问题。在本示例中主要采用一个自定义的函数来处理问题，这个自定义函数大体可以按如下代码编写：
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
视图：
