0

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

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

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

4

2 回答 2

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)

于 2019-10-20T11:44:00.410 回答
0

使用本机 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

在此处输入图像描述

于 2019-10-20T13:22:00.640 回答