在VBA中根据财务日历查找一个月中的第几周

Question

问题是2019年9月6日需要显示为9月的第2周，但我得到的是9月第1周。每周no将在每个星期六更改。我的财务日历是4-4-5基数，

我的财务日历从2018年12月的最后一周开始到2019年12月27日。下面是我需要显示的格式。

Jan = 4 weeks
Feb = 4 weeks
Mar = 5 weeks
Apr = 4 weeks
May = 4 weeks
Jun = 5 weeks
Jul = 4 weeks
Aug = 4 weeks
Sep = 5 weeks
Oct = 4 weeks
Nov = 4 weeks
Dec = 5 weeks (sometimes 6)

weekNo= Trim(Format(dateCell.Value, "\ mmm " & "\W" & DatePart("ww", dateCell) - DatePart("ww", DateSerial(Year(dateCell), Month(dateCell), 1)) +1))

VBA代码尝试:它正在返回ISO周编号作为9月第1周，但我需要根据财务日历的周编号。这是2019年9月6日需要显示为9月第2周。

Answer 1

为了测试这段代码，我添加了全年的日期(列A)以及它们各自的周数字(列B)和月份(列C)。我遵循您的请求，您指定的财务日历是在4-4-5的基础上。

代码会产生以下结果：

​

​

代码：

Sub finDates()
    Dim dateCell As Long, weekNo As Long, weekYear As Long, monthNo As Long
    Dim finalResult As String
    Dim calc As Double
    Dim rng As Range

    For Each rng In Range("A2:A53")
        dateCell = rng.Value 'column A
        weekYear = DatePart("ww", dateCell, vbSaturday) 'column B
        calc = weekYear / (4 + (1 / 3))
        monthNo = Application.WorksheetFunction.RoundUp(calc, 0) 'column C
        weekNo = Application.WorksheetFunction.RoundUp((calc - Fix(calc)) * (4 + 1 / 3), 0)

        If weekNo Then
            finalResult = Format(DateSerial(2019, monthNo, 1), "\ mmm " & "\W" & weekNo)
        Else
            finalResult = Format(DateSerial(2019, monthNo, 1), "\ mmm " & "\W" & 5)
        End If

        rng.Offset(0, 3).Value = finalResult 'column D
    Next rng
End Sub

也就是说，如果您只想分析一个日期，则可以使用以下代码：

Sub finDates()
    Dim dateCell As Long, weekNo As Long, weekYear As Long, monthNo As Long
    Dim finalResult As String
    Dim calc As Double

    dateCell = Range("A1").Value
    weekYear = DatePart("ww", dateCell, vbSaturday)
    calc = weekYear / (4 + (1 / 3))
    monthNo = Application.WorksheetFunction.RoundUp(calc, 0)
    weekNo = Application.WorksheetFunction.RoundUp((calc - Fix(calc)) * (4 + 1 / 3), 0)

    If weekNo Then
        finalResult = Format(DateSerial(2019, monthNo, 1), "\ mmm " & "\W" & weekNo)
    Else
        finalResult = Format(DateSerial(2019, monthNo, 1), "\ mmm " & "\W" & 5)
    End If

    Range("B1").Value = finalResult
End Sub

结果：

​

​

希望它能帮上忙！