XL 2010 automatisation des dates dans un planning

[shitoryu]

Bonjour,
je cherche à automatiser l'inscription des dates en fonction de l'année, du n° de la semaine et du jour :

si en A1 = 2019
si en A3 = semaine "37"
si en B3 = "lundi"

alors en C3 = 9 septembre

J'ai placé un fichier en copie
Merci à vous !
B.

 

[job75]

Bonjour shitoryu,

Voyez le fichier joint et cette fonction VBA à placer impérativement dans un module standard :

Function DatSem(an%, sem%, jour$) As Variant
Dim i%, dat As Date
jour = LCase(jour) 'minuscules
DatSem = ""
For i = 1 To 365 - IsDate("29/2/" & an)
    dat = DateSerial(an, 1, i)
    If Application.IsoWeekNum(dat) = sem And Format(dat, "dddd") = jour Then DatSem = dat: Exit Function
Next
End Function

Elle est utilisée dans la formule en C3, à tirer vers le bas :

=DatSem(A$1;A3;B3)

A+

 

[shitoryu]

merci !
la formule fonctionne dans votre tableau mais quand je la recopie dans ma version cela plante. J'ai pourtant l'impression de tout reprendre à l'identique.
vous pourriez jeter un œil et m'expliquer la raison de mon erreur ?
Merci encore,
B.

 

[job75]

Le code précédent utilise la fonction Excel NO.SEMAINE.ISO (IsoWeekNum).

Et en effet je crois que cette fonction n'est pas reconnue sur Excel 2010.

Utilisez alors ce code :

Function DatSem(an%, sem%, jour$) As Variant
Dim i%, dat As Date, t As Date
jour = LCase(jour) 'minuscules
DatSem = ""
For i = 1 To 365 - IsDate("29/2/" & an)
    dat = DateSerial(an, 1, i)
    t = DateSerial(Year(dat + (8 - Weekday(dat)) Mod 7 - 3), 1, 1)
    If ((dat - t - 3 + (Weekday(t) + 1) Mod 7)) \ 7 + 1 = sem And Format(dat, "dddd") = jour Then DatSem = dat: Exit Function
Next
End Function

 

[job75]

Je me rends compte qu'une boucle est tout à fait inutile.

Dans ce fichier (3) ce code paraît convenir :

Function DatSem(an%, sem%, jour$) As Variant
Dim a, n As Variant, premier As Date, lundi As Date
jour = LCase(jour) 'minuscules
a = Array("lundi", "mardi", "mercredi", "jeudi", "vendredi", "samedi", "dimanche")
DatSem = ""
n = Application.Match(jour, a, 0)
If sem < 1 Or IsError(n) Then Exit Function
premier = DateSerial(an, 1, 1) '1er de l'an
lundi = 7 * sem + premier - Weekday(premier) - 5 'lundi de la semaine
If Weekday(premier) > 5 Then lundi = lundi + 7 'semaine ISO
If Year(lundi) <= an Then DatSem = lundi + n - 1 'avec limitation du numéro de semaine
End Function

Edit : ajouté la limitation du numéro de semaine.

 

[shitoryu]

super !
un grand merci !

 

[job75]

J'ai modifié le test de limitation du numéro de semaine, prenez le bon fichier.

 

[shitoryu]

j'ai repris votre fichier. Tout fonctionne parfaitement.
Merci encore (si j'ai bon souvenir vous m'avez déjà aider pour d'autres choses !)