VBA代码分享:将指定星期数转换成标准日期格式

2023-11-28 16:24:50 浏览数 (2)

标签: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

有兴趣的朋友可以试试。

0 人点赞