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

【问题标题】：how to get year and week from date如何从日期获取年份和星期
【发布时间】：2019-10-20 11:17:26
【问题描述】：

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

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

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

【问题讨论】：

您能否至少包括您在 VBA 中尝试的内容，以及一些示例数据和预期输出

标签： excel vba week-number 2-digit-year

【解决方案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)

【讨论】：

【解决方案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 函数的默认值相同

编辑

根据 cmets，似乎 OP 不想使用 Excel 默认定义 WEEKNUMBER。

可以使用ISOweeknumber 并可能避免丢失序列号YR,WN 的问题。但是，如果 12 月日期确实在下一年的第 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 函数来代替可用的工作表函数。
稍微修改一下你的循环代码，这里似乎可以正常工作，用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

【讨论】：

感谢它看起来很棒，但在年底我使用此代码时会出现一个问题，它会跳过 20,01。 ActiveCell.Offset(0, i) = Format(D + c * 7, "yy") & "," & Format(Format(D + c * 7, "ww"), "00") 可能是因为19， 53 和 20,01 一样弱。
@marwineper 你是如何使用它的？输入是什么？结果如何？
输入是当前日期 =now() 并且我使用简单循环 c = 0 For i = 0 To t - 1 ActiveCell.Offset(0, i) = Format(D + c * 7, " yy") & "," & Format(Format(D + c * 7, "ww"), "00") c = c + 1 下一个 i
@marwineper 您认为应该是第 1 周的日期是什么？
这个循环是按周排序的，但排序的项目有特定的日期，所以它们不会跳过任何一周