Office中国论坛/Access中国论坛

标题: 【Access小品】周而复始 -- 获取每月各周日期范围示例 [打印本页]

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

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

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

示例：[attach]56232[/attach]

视图：
[attach]56233[/attach]

作者: yanwei82123300 时间: 2015-4-27 13:07
看看这个就是todaynew 老师帮助做的！用处非常大

作者: 5988143 时间: 2015-4-27 13:20
老汉的作品一往如故的收藏中~

作者: tmtony 时间: 2015-4-27 14:28
收藏了！

作者: fjh 时间: 2016-3-24 12:01
收藏学习

作者: owen2016 时间: 2016-8-20 15:15
已经下载学习，谢谢

作者: YXH_YXH 时间: 2019-10-2 18:11
谢谢分享！！！

欢迎光临 Office中国论坛/Access中国论坛 (http://www.office-cn.net/)