VBA 类似于桌面日历的一个月的周数

Question

你能帮我添加特定月份的周数吗？

这个vba:

With Target
If .Column <> 10 Or .Row < 1 Then Exit Sub
If .Value = "Select" Then
    If .Offset(0, 1).Value = "" Then
        .Offset(0, 1).NumberFormat = "mm/dd/yy"
        .Offset(0, 1).Value = Now - 1      
    End If

我对周数的定义是基于从周日到周六的整周：

如果每个月的第一天不是从星期日开始，那么该月第一个星期六之前的所有日子都将是第 1 周
周日到周六的下一组将是第 2 周、第 3 周、第 4 周 等。除非该月从星期日开始，在这种情况下，集合将是 第 1 周、第 2 周、第三周等
如果该月未在星期六结束，则从星期日到月末将为 第 N+1 周，其中 N 是步骤 2 给出的最后一个完整周。

例如：这个月，3月1日是星期三。所以3月1日-4日（周三-周六）为1周，依此类推

Answer 1

您可以尝试看看 WeekNum 功能是否适合您的目的。

您可以像这样在您的代码中使用它：

.Offset(0, 2).Value = WorksheetFunction.WeekNum(Now - 1)

文档说：

Returns the week number of a specific date. For example, the week containing January 1 is the first week of the year, and is numbered week 1.

There are two systems used for this function:

System 1 The week containing January 1 is the first week of the year, and is numbered week 1.

System 2 The week containing the first Thursday of the year is the first week of the year, and is numbered as week 1. This system is the methodology specified in ISO 8601, which is commonly known as the European week numbering system.

编辑

OP 对周的定义是每个桌面日历，其中每个绿色块代表一周 - 因此 2017 年 3 月有 5 周。注意 2016 年 1 月在此系统下有六个星期！

因此，WeekNum公式不会给出预期的结果。相反，可以使用以下函数：

Function GetCalendarTypeMonthWeek(dt As Date) As String

    Dim lngDayOfMonth As Long
    Dim lngWeekDay As Long
    Dim dtFirstDayOfMonth As Date
    Dim lngFactor As Long

    lngDayOfMonth = Day(dt)
    lngWeekDay = Weekday(dt, vbSunday) '<~~ Sunday=1, Monday=2, etc
    
    'does month start on Sunday?
    dtFirstDayOfMonth = DateValue("01-" & Month(dt) & "-" & Year(dt))
    If Weekday(dtFirstDayOfMonth, vbSunday) = 1 Then
        lngFactor = 1
    Else
        lngFactor = 2
    End If
    
    'get calendar week number for date
    GetCalendarTypeMonthWeek = "Week " & CStr(Int((lngDayOfMonth - lngWeekDay) / 7) + lngFactor)

End Function

在示例代码中使用，如：

.Offset(0, 2).Value = GetMonthWeek(Now - 1)

Answer 2

我想下一个函数会return你想要的值：

Function WeekOfTheMonth(DateRef As Date) As Integer
    Dim WeekFirstDayRefMonth As Integer
    WeekFirstDayRefMonth = Application.WeekNum(DateSerial(Year(DateRef), Month(DateRef), 1), 2)
    Dim WeekLastDayRefMonthB As Integer        
    WeekLastDayRefMonthB = Application.WeekNum(DateSerial(Year(DateRef), Month(DateRef), 1) - 1, 2)
    Select Case WeekFirstDayRefMonth - WeekLastDayRefMonthB
        Case 0: WeekOfTheMonth = Application.WeekNum(DateRef, 2) - WeekLastDayRefMonthB + 1
        Case 1: WeekOfTheMonth = Application.WeekNum(DateRef, 2) - WeekLastDayRefMonthB
        Case Else: WeekOfTheMonth = Application.WeekNum(DateRef, 2)
    End Select
End Function

只需在您的代码中写入 WeekOfTheMonth("place your date here") 即可。请注意：我没有检查此代码的所有场景，因此如果您得到意想不到的结果，请告诉我。

VBA 类似于桌面日历的一个月的周数

VBA for week number of a month similar to desktop calendar

excel

week-number

vba

编辑