Date et heure MondayOffweek

[patricktoulon]

une autre dans le même genre
le lundi d'une semaine X d'une année(vba/formule)

Function MondayOffWeek(annee&, Lweek&)
Dim D As Date, WekD&
D = CDate("01/01/" & annee)
WekD = Weekday(D, vbUseSystemDayOfWeek)
D = D + Lweek * 7 - IIf(WekD <> 1, WekD - 1, 0)
MondayOffWeek = D
End Function

Sub testx()
    MsgBox Format(MondayOffWeek(2021, 1), "dddd dd mm yyyy")
    MsgBox Format(MondayOffWeek(2021, 23), "dddd dd mm yyyy")
    MsgBox Format(MondayOffWeek(2021, 52), "dddd dd mm yyyy")
End Sub

formule:
=MondayOffWeek(année, Nieme semaine )

exemple
le lundi de la semaine 23
=MondayOffWeek(2021, 23)

 

[patricktoulon]

re
petite correction semaine ISO

Function MondayOffWeek(annee&, Optional ByVal Lweek& = 1)
    Dim D As Date, WekD&, Z&
    D = CDate("01/01/" & annee)
    WekD = Weekday(D, vbUseSystemDayOfWeek)
    D = D - IIf(WekD <> 1, WekD - 1, 0)
    Z = CLng(D)
    Z = Evaluate("= TRUNC((" & Z & "-WEEKDAY(" & Z & ",2)+11-DATE(YEAR(" & Z & "-WEEKDAY(" & Z & " ,2)+4),1,1))/7)")
    MondayOffWeek = D + IIf(Z > 1, 7, 0) + ((Lweek - 1) * 7)
End Function

 

[patricktoulon]

bonsoir

Function MondayOfWeek(year, Optional w As Long = 1)
    Dim Dat
    Dat = CDate("01/01/" & year): Dat = (Dat - (Weekday(Dat, vbMonday) - 1))
    MondayOfWeek = Dat - (7 * (w - Abs(WorksheetFunction.IsoWeekNum(Dat) >= 1)))
End Function

 

[patricktoulon]

Bonjour
j'ai réuni les deux mondayOfweek et NiemdayOfWeek l'autre fonction dans la rubrique fonction personnalisée

Sub test3()
    Dim i%
    For i = 2010 To 2025 'tout les lundis
        MsgBox Format(NiemDayOfWeek2(i, 1, 1), "dddd dd mm yyyy") 'les lundis
       ' MsgBox Format(NiemDayOfWeek2(i, 1, 3), "dddd dd mm yyyy") 'les mercredis
    Next
End Sub

Public Function NiemDayOfWeek2(year&, Optional week& = 1, Optional Niem& = 1)
    NiemDayOfWeek2 = CDate("04/01/" & year) - Weekday(CDate("04/01/" & year), 2) + (7 * week) - 6 + Niem - 1
End Function

et sa petite soeur NiemeMondayOfYear qui peut être utile dans l'organisation de planning

Sub test2()
    For i = 2020 To 2025 'tout les lundis
        MsgBox Format(NiemeMondayOfYear(i, 1), "dddd dd mm yyyy")
    Next
End Sub

'le N ème lundi de l'année  et pas de la semaine (X)
Function NiemeMondayOfYear(a, Niem As Long)
    Dat = CDate("01/01/" & a): Dat = (Dat + ((7 - (Weekday(Dat, vbMonday) - 1))) * Abs(Weekday(Dat, vbMonday) > 1)) + (Niem - 1)
    NiemeMondayOfYear = Dat
End Function

Patrick