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

Question

I need help in making code to extract the year and week number from the date. I needed to segregate orders by week, not on individual days. I need to get format yy, WW. In excel function I can write something like this:

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

but I can't write it in VBA code.

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

data - (after formating)

03.02.2020 - (20,06)

27.12.2019 - (19,52)

27.12.2019 - (19,52)

Answer 2

Using native VBA functions, something like:

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

End Function

If you want to hard-code the comma separator, just replace Application.International(xlDecimalSeparator) with ","

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

EDIT

Based on the comments, it seems the OP does NOT want to use the Excel default definition of WEEKNUMBER .

One can use the ISOweeknumber and probably avoid the issue of missing a serial YR,WN . However, one would have to add a test to adjust the year for those instances when a December date is really in Week 1 of the subsequent year.

I suggest trying:

Edit to work around bug in VBA Date functions

also year will correspond with weeknumber at the beginning/end of the year

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

Additional Comments

• You can replace DatePart("ww", dt - Weekday(dt, vbMonday) + 4, vbMonday, vbFirstFourDays) with Application.WorksheetFunction.IsoWeekNum(dt) . I'm not sure which method is more efficient, although I generally prefer using native VBA functions in place of Worksheet functions when available.

• Modifying your looping code a bit, it seems to work OK here, filling rows 1 and 2 with yy,ww and the corresponding date in row 2 (I added row 2 fort for error checking). Doesn't miss any weeks.

---

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