blob: faee7a2cc610c7228e571c19076a0a04189ebeb5 (
plain)
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
|
Attribute VB_Name = "ModTask_01"
Option Explicit
Public Const strMyTitle As String = "Eric Cheung"
Function FindWeekNumGivenDate(nInputDate As Long) As Integer
'' Credit:
'' http://kbase.icbconsulting.com/vba/determine-the-week-number-using-a-date
Dim nNum_01 As Integer, nNum_02 As Integer, nNum_03 As Long, nNum_04 As Integer
If nInputDate < 1 Then
FindWeekNumGivenDate = 0
Exit Function
End If
nNum_01 = Weekday(nInputDate, vbSunday)
nNum_02 = Year(nInputDate + (8 - nNum_01) Mod 7 - 3)
nNum_03 = DateSerial(nNum_02, 1, 1)
nNum_04 = (Weekday(nNum_03, vbSunday) + 1) Mod 7
FindWeekNumGivenDate = Int((nInputDate - nNum_03 - 3 + nNum_04) / 7) + 1
End Function
Function FindNumWeekGivenYear(nInputYear As Integer) As Integer
FindNumWeekGivenYear = FindWeekNumGivenDate(DateSerial(nInputYear, 12, 31))
End Function
Sub Task_01()
Const nStartYear As Integer = 1900
Const nStartEnd As Integer = 2100
Dim strMsg As String
Dim nLoop As Integer
For nLoop = nStartYear To nStartEnd
If FindNumWeekGivenYear(nLoop) = 53 Then
If strMsg <> "" Then
strMsg = strMsg & ", "
End If
strMsg = strMsg & nLoop
End If
Next nLoop
MsgBox strMsg, vbOKOnly, strMyTitle
End Sub
|
