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

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)

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)为","

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

编辑

根据评论，OP 似乎不想使用 Excel 默认定义的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 函数代替 Worksheet 函数。

• 稍微修改一下你的循环代码，它似乎在这里工作正常，用yy,ww第 2 行中的相应日期填充第 1 行和第 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