访问VBA：将ISO周编号转换为日期范围时出错


ACCESS VBA: Error when converting ISO Week Number to Date Range

我正在尝试根据ISO周编号创建一个简单的周选择器，每当用户单击"当前周"或"上周"或"下周"时，它将为我提供周一日期和周日日期按钮，因为我将选择那些日期内的所有交易。

我已经按照以下步骤操作了
MS Access获得ISO标准周编号
以获得特定日期的正确星期数，然后按照https://answers.microsoft.com/en-us/msoffice/forum/msoffice_access-mso_other/convert-week-number-to将日期转换回日期-date / 3d0f8c90-a155-e011-8dfc-68b599b31bf5。

今年的转换效果很好，每当我单击上一周或下一周时，它都会带来正确的星期一和星期日以及正确的星期数，但是，当它到达2021年的第一周时，就会带来正确的日期为04/01/2021和10/01/2021(分别为从和到)，则单击"下周"将带上日期为"从= 06/01/2021"和"至= 12/01/2021" ，并且停止前进，点击不会更改日期。

单击"上一个星期"时，它会一直持续到2020年的第1周，这将带来正确的日期30/12/2019和05/01/2020，但是，单击下一个"上一个星期"将带来日期23 2018年12月12日和2018年12月29日，但是在这种情况下，如果我继续单击"上周"按钮，它将继续正确返回到2018年。真是发疯了。

我认为将周数转换为日期范围时出现问题是在DateSerial中，我试图弄清楚，但我做不到。

我希望你们能帮助我。

先谢谢您。

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
'''' This is the function in a module to get the week number

Public Function ISOWeek(MyDate As Date) As Integer

    ISOWeek = Format(MyDate,"ww", vbMonday, vbFirstFourDays)
   
    If ISOWeek > 52 Then
   
        If Format(MyDate + 7,"ww", vbMonday, vbFirstFourDays) = 2 Then ISOWeek = 1
       
    End If

End Function


'''' These subs run on the form code

Private Sub NextWeek_Click()

    Dim SelectedWeek As Date

    SelectedWeek = Me.Date_From.Value

    FirstDayWeek = DateAdd("ww", ISOWeek(SelectedWeek), DateSerial(Year(SelectedWeek), 1, 1) - 2)

    LastDayWeek = DateAdd("ww", ISOWeek(SelectedWeek), DateSerial(Year(SelectedWeek), 1, 1) + 4)

    Me.Date_From.Value = FirstDayWeek
    Me.Date_To.Value = LastDayWeek

End Sub

Private Sub PreviousWeek_Click()

    Dim SelectedWeek As Date

    SelectedWeek = Me.Date_From.Value
   
    FirstDayWeek = DateAdd("ww", ISOWeek(SelectedWeek) - 2, DateSerial(Year(SelectedWeek), 1, 1) - 2)

    LastDayWeek = DateAdd("ww", ISOWeek(SelectedWeek) - 2, DateSerial(Year(SelectedWeek), 1, 1) + 4)

    Me.Date_From.Value = FirstDayWeek
    Me.Date_To.Value = LastDayWeek

End Sub

从日期计算中保留星期数，它们只会使事情复杂化。

通过使用下面列出的通用函数，可以将两个函数简化为：

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
Private Sub NextWeek_Click()

    Me.Date_From.Value = DateNextWeekPrimo(Me.Date_From.Value, vbMonday)
    Me.Date_To.Value = DateNextWeekUltimo(Me.Date_From.Value, vbMonday)

End Sub

Private Sub PreviousWeek_Click()

    Me.Date_From.Value = DatePreviousWeekPrimo(Me.Date_From.Value, vbMonday)
    Me.Date_To.Value = DatePreviousWeekUltimo(Me.Date_From.Value, vbMonday)

End Sub


' Returns the primo date of the week following the week of the date passed.
'
' 2016-01-13. Gustav Brock, Cactus Data ApS, CPH.
'
Public Function DateNextWeekPrimo( _
    ByVal DateThisWeek As Date, _
    Optional ByVal FirstDayOfWeek As VbDayOfWeek = vbSunday) _
    As Date

    Dim Interval    As String
    Dim Number      As Double
    Dim ResultDate  As Date
   
    Number = 1
    Interval ="ww"
   
    ' Offset date.
    ResultDate = DateAdd(Interval, Number, DateThisWeek)
   
    ' Return first weekday with no time part.
    ResultDate = DateAdd("d", 1 - Weekday(ResultDate, FirstDayOfWeek), Fix(ResultDate))
   
    DateNextWeekPrimo = ResultDate
   
End Function


' Returns the ultimo date of the week following the week of the date passed.
'
' 2016-01-13. Gustav Brock, Cactus Data ApS, CPH.
'
Public Function DateNextWeekUltimo( _
    ByVal DateThisWeek As Date, _
    Optional ByVal FirstDayOfWeek As VbDayOfWeek = vbSunday) _
    As Date

    Dim Interval    As String
    Dim Number      As Double
    Dim ResultDate  As Date
   
    Number = 1
    Interval ="ww"
   
    ' Offset date.
    ResultDate = DateAdd(Interval, Number, DateThisWeek)

    ' Return last weekday with no time part.
    ResultDate = DateAdd("d", 7 - Weekday(ResultDate, FirstDayOfWeek), Fix(ResultDate))
   
    DateNextWeekUltimo = ResultDate
   
End Function


' Returns the primo date of the week preceding the week of the date passed.
'
' 2016-01-13. Gustav Brock, Cactus Data ApS, CPH.
'
Public Function DatePreviousWeekPrimo( _
    ByVal DateThisWeek As Date, _
    Optional ByVal FirstDayOfWeek As VbDayOfWeek = vbSunday) _
    As Date

    Dim Interval    As String
    Dim Number      As Double
    Dim ResultDate  As Date
   
    Number = -1
    Interval ="ww"
   
    ' Offset date.
    ResultDate = DateAdd(Interval, Number, DateThisWeek)
   
    ' Return first weekday with no time part.
    ResultDate = DateAdd("d", 1 - Weekday(ResultDate, FirstDayOfWeek), Fix(ResultDate))
   
    DatePreviousWeekPrimo = ResultDate
   
End Function


' Returns the ultimo date of the week preceding the week of the date passed.
'
' 2016-01-13. Gustav Brock, Cactus Data ApS, CPH.
'
Public Function DatePreviousWeekUltimo( _
    ByVal DateThisWeek As Date, _
    Optional ByVal FirstDayOfWeek As VbDayOfWeek = vbSunday) _
    As Date

    Dim Interval    As String
    Dim Number      As Double
    Dim ResultDate  As Date
   
    Number = -1
    Interval ="ww"
   
    ' Offset date.
    ResultDate = DateAdd(Interval, Number, DateThisWeek)

    ' Return last weekday with no time part.
    ResultDate = DateAdd("d", 7 - Weekday(ResultDate, FirstDayOfWeek), Fix(ResultDate))
   
    DatePreviousWeekUltimo = ResultDate
   
End Function
相关讨论