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

Question

我需要帮助来编写代码以从日期中提取年份和周数。 我需要按周分隔订单，而不是在个别日子。 我需要获取格式 yy, WW。 在 excel function 我可以这样写：

=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)

27.12.2019 - (19,52)

27.12.2019 - (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)替换为","

Note that the defaults for the first day of week and first week of year are the same for the VBA Format function as they are for the Excel WEEKNUM function

编辑

根据评论，OP 似乎不想使用 WEEKNUMBER 的WEEKNUMBER默认定义。

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

我建议尝试：

编辑以解决 VBA 日期函数中的错误

year 也将对应于年初/年末的 weeknumber

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 函数来代替可用的工作表函数。

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

---

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