标签:VBA
在forum.ozgrid.com中看到的一段代码,很有意思,特在此分享。
代码的意图是,给出某年某个星期的第几天,运行代码后,给出这天的日期。例如下图1所示,在输入框中输入“2003.1”,即想要知道2020年第3周第1天的日期。
图1
运行代码后,结果如下图2所示。
图2
详细代码如下:
代码语言:javascript复制'转换YYWW.DD为YYYY-MM-DD
Sub WeeksToDates()
'以yywk.dd格式的日期
Dim Todayf As String
'输入日期所在的年份
Dim Yearf As Integer
'所代表的输入日期
Dim Dayf As Integer
'计算之后的某月的日期
Dim Dayf2 As Integer
'输入日期的月份
Dim monthf As Integer
'1月1日至1月4日
Dim First4Jan As Integer
'ISO 8601中规定的普通日期
Dim OrdinalDate As Integer
'从年初到每月1日已经过去了多少天
Dim DayOfWeek() As Variant
'以yyyy-mm-dd形式的最终日期
Dim FinalDate As Date
Dim i As Long
'Todayf = "2302.2"
Todayf = InputBox("请输入周数(格式YYWW.DD,例如2302.2,表示2023年第2周的第2天)", "输入转换为对应的日期")
Yearf = "20" & Left(Todayf, 2)
Dayf = Right(Todayf, 1)
If (Yearf / 4 - Int(Yearf / 4) = 0) Then
DayOfWeek() = Array(0, 31, 60, 91, 121, 152, 182, 213, 244, 274, 305, 335, 366)
Else
DayOfWeek() = Array(0, 31, 59, 90, 120, 151, 181, 212, 243, 273, 304, 334, 365)
End If
First4Jan = Weekday(DateSerial(Yearf, 1, 4), 2)
OrdinalDate = Mid(Todayf, 3, 2) * 7 Dayf - (First4Jan 3)
For i = 1 To 13
If OrdinalDate - DayOfWeek(i) <= 0 Then
monthf = i
Dayf2 = OrdinalDate - DayOfWeek(i - 1)
GoTo DateConstruction
Else
End If
Next i
DateConstruction:
FinalDate = DateSerial(Yearf, monthf, Dayf2)
MsgBox FinalDate
End Sub
有兴趣的朋友可以试试。