根据VBA中的财务日历查找一个月中的星期几

Question

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

我的财务日历从12月的最后一周（2018）开始到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代码：它将在9月的第1周返回ISO周编号，但根据财务日历，我需要的周编号为0。即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

结果：

希望有帮助！