Get the week number of the month from a specific date on VBA

Question

I have a set of dates that I should get the week of the month. There is a lot of literature on how to get the week of the year using VBA code, but not how to get the week number of the month. For example, 03-Mar-13 will give the week of March 1, instead I get the result of the 10th week.
All help apreciated

Answer 1

This is not the most elegant code, but it worked for me.

Some assumptions:

• It is UDF and can be used in a spreadsheet or in code
• Week starts on Sundays.
• Week 1 may be incomplete.

=====

Function WeekOfMonth(selDate As Date)
    Dim DayOfFirst As Integer
    Dim StartOfWeek2 As Integer
    Dim weekNum As Integer

    DayOfFirst = Weekday(DateSerial(Year(selDate), Month(selDate), 1), vbSunday)
    StartOfWeek2 = (7 - DayOfFirst) + 2

    Select Case selDate
        Case DateSerial(Year(selDate), Month(selDate), 1) _
        To DateSerial(Year(selDate), Month(selDate), StartOfWeek2 - 1)
            weekNum = 1

        Case DateSerial(Year(selDate), Month(selDate), StartOfWeek2) _
        To DateSerial(Year(selDate), Month(selDate), StartOfWeek2 + 6)
            weekNum = 2

        Case DateSerial(Year(selDate), Month(selDate), StartOfWeek2 + 7) _
        To DateSerial(Year(selDate), Month(selDate), StartOfWeek2 + 13)
            weekNum = 3

        Case DateSerial(Year(selDate), Month(selDate), StartOfWeek2 + 14) _
        To DateSerial(Year(selDate), Month(selDate), StartOfWeek2 + 20)
            weekNum = 4

        Case DateSerial(Year(selDate), Month(selDate), StartOfWeek2 + 21) _
        To DateSerial(Year(selDate), Month(selDate), StartOfWeek2 + 27)
            weekNum = 5

        Case DateSerial(Year(selDate), Month(selDate), StartOfWeek2 + 28) _
        To DateSerial(Year(selDate), Month(selDate) + 1, 1)
            weekNum = 6
    End Select

    WeekOfMonth = weekNum
End Function

Answer 2

, , , . ( rvalerio)

Private Function getWeekOfMonth(testDate As Date) As Integer
    getWeekOfMonth = CInt(Format(testDate, "ww")) - CInt(Format(Format(testDate, "mm/01/yyyy"), "ww")) + 1
End Function

Answer 3

:

• 1 = 1-
• 2 = Nth
• = 2 - 1 + 1

?

Answer 4

, : ", 03--13 1- ". , , 2- , 1 - 6- , 3- 1- , , , 2- .

, , guitarthrower, rvalerio user3496574, , , . , 6, , 5 ( , , 4 ).

, . , . , 7 , 1- - - , 7, .

Excel - :

=ROUNDUP(DAY(MyDate)/7,0)

VBA , , , :

Function WeekOfMonth(TestDate As Date) As Integer
    WeekOfMonth = Application.WorksheetFunction.RoundUp(Day(TestDate) / 7, 0)
End Function 

, , , Excel, , , :

Function WeekOfMonth(TestDate As Date) As Integer

    WeekOfMonth = RoundUpVBA(Day(TestDate) / 7,0)

End Function


Function RoundUpVBA(InputDbl As Double, Digits As Integer) As Double

    If InputDbl >= O Then
        If InputDbl = Round(InputDbl, Digits) Then RoundUpVBA = InputDbl Else RoundUpVBA = Round(InputDbl + 0.5 / (10 ^ Digits), Digits)
    Else
        If InputDbl = Round(InputDbl, Digits) Then RoundUpVBA = InputDbl Else RoundUpVBA = Round(InputDbl - 0.5 / (10 ^ Digits), Digits)
    End If

End Function

, Excel 3496574, :

=WEEKNUM(MyDate) - WEEKNUM(EOMONTH(MyDate,-1)+1)+1

, VBA.

- , , , , .

Qaru VBA, . C++ , . , .

VBA, , , (, , , ).

, , , , VBA Round (round-half-even), Excel , CInt, - Int ( Fix), .

, Banker , , . , .5 , , . , , , , , . , , .

, , , .

Excel:

=ROUNDUP(((DAY(MyDate)+WEEKDAY(EOMONTH(MyDate,-1)+1)-1) / 7), 0)

, .

03--13 3 7 8 7. , 2 1.

VBA:

Function WeekOfMonth(TestDate As Date) As Integer

    Dim FirstDayOfMonth As Date
    Dim Offset As Integer

    FirstDayOfMonth = TestDate - Day(TestDate) + 1
    Offset = Weekday(FirstDayOfMonth)

    WeekOfMonth = Application.WorksheetFunction.RoundUp((((Day(TestDate) + Offset) - 1) / 7), 0)

End Function

Exceljet .

, . , , :

=getWeekOfMonth(MyDate-WEEKDAY(EOMONTH(MyDate,-1)+1)+8)-1

, , VBA , . -:

WeekOfMonth = Day(TestDate) / 7  ' divide by 7
WeekOfMonth = Fix(WeekOfMonth - 0.0001) + 1  ' ugly rounding up

. , , 1 7 , , 1, 0.

:

WeekOfMonth = Day(TestDate) / 7  ' divide by 7
WeekOfMonth = Day(WeekOfMonth + 1.9999)  ' uglier rounding up

, VBA - . ( , , , , VBA Excel .)

, Int , , , , CBool 0 , - , - . - .

, , :

Function WeekOfMonth(TestDate As Date) As Integer

    Dim TempWeekDbl As Double

    TempWeekDbl = Day(TestDate) / 7  ' divide by 7
    TempWeekDbl = Fix(TempWeekDbl - 0.0001) + 1  ' ugly rounding up

    WeekOfMonth = TempWeekDbl

End Function

, , , :

Function RoundUpToWhole(InputDbl As Double) As Integer

    Dim TruncatedDbl As Double

    TruncatedDbl = Fix(InputDbl)

    If TruncatedDbl <> InputDbl Then
        If TruncatedDbl >= 0 Then RoundUpToWhole = TruncatedDbl + 1 Else RoundUpToWhole = TruncatedDbl - 1
    Else
        RoundUpToWhole = TruncatedDbl
    End If

End Function

RoundUpVBA, , Excel ROUNDUP, . Excel, ROUND .

, , , , , , 0,14 ( , 0,0001). , , . , , , .

.

I wonder if the famous last words were ever the famous last words?