如何从日期获得年份和星期

Question

在编写代码以获取日期中的年和周编号时，我需要帮助。我需要按周隔离订单，而不是每天。 我需要获取格式yy，WW。 在excel函数中，我可以这样写：

=CONCATENATE(RIGHT(YEAR(P13);2);",";TEXT(WEEKNUM(P13);"00"))

但是我不能用VBA代码编写它。

Answer 1

D = now()
For i = 0 To t - 1

ActiveCell.Offset(0, i) = Application.WorksheetFunction.Right(Year(D + c * 7), 2)) & "," & Application.WorksheetFunction.WeekNum(D + c * 7)

c = c + 1

Next i

数据-（格式化后）

03.02.2020-（20,06）

2019年12月27日-（19,52）

2019年12月27日-（19,52）

Answer 2

使用本地VBA功能，例如：

Function vbYrWN(dt As Date) As String
    vbYrWN = Format(dt, "yy") & _
        Application.International(xlDecimalSeparator) & _
            Format(Format(dt, "ww"), "00")

End Function

如果您要硬编码逗号分隔符，只需将Application.International(xlDecimalSeparator)替换为","

请注意，first day of week和first week of year的默认值与VBA Format函数的默认值相同，与Excel WEEKNUM函数的默认值相同

编辑

根据评论，看来OP不想使用Excel的默认定义WEEKNUMBER。

一个人可以使用ISOweeknumber，并且可以避免丢失序列YR,WN的问题。但是，当十二月日期确实在下一年的第1周时，就必须添加测试来调整这些实例的年份。

我建议尝试：

编辑以解决VBA日期功能中的错误

年份也将与年初/周的周号相对应

Option Explicit
Function vbYrWN(dt As Date) As String
    Dim yr As Date
    If DatePart("ww", dt - Weekday(dt, vbMonday) + 4, vbMonday, vbFirstFourDays) = 1 And _
        DatePart("y", dt) > 350 Then
        yr = DateSerial(Year(dt) + 1, 1, 1)
    ElseIf DatePart("ww", dt - Weekday(dt, vbMonday) + 4, vbMonday, vbFirstFourDays) >= 52 And _
        DatePart("y", dt) <= 7 Then
        yr = DateSerial(Year(dt), 1, 0)
    Else
        yr = dt
    End If

    vbYrWN = Format(yr, "yy") & _
        Application.International(xlDecimalSeparator) & _
            Format(Format(dt - Weekday(dt, vbMonday) + 4, "ww", vbMonday, vbFirstFourDays), "00")
End Function

其他评论

• 您可以将DatePart("ww", dt - Weekday(dt, vbMonday) + 4, vbMonday, vbFirstFourDays)替换为Application.WorksheetFunction.IsoWeekNum(dt)。我不确定哪种方法更有效，尽管我通常更喜欢使用本地VBA函数代替可用的Worksheet函数。

• 稍微修改一下循环代码，在这里似乎可以正常工作，用yy,ww填充第1行和第2行以及第2行中的相应日期（我在第2行要塞中添加了错误检查）。不会错过任何星期。

---

Sub test()
 Dim c As Long, i As Long, t As Long
 Dim R As Range
 Dim D As Date

 D = #12/25/2019#
 Set R = Range("A1")
    R.EntireRow.NumberFormat = "@"
 t = 10

 c = 0
 For i = 0 To t - 1
    R.Offset(0, i) = vbYrWN(D + c * 7)
    R.Offset(1, i) = D + c * 7
    c = c + 1
Next i

End Sub