Formule: Semaine ISO / année / jour

[titine06]

Bonsoir,

Je cherche une formule qui en fonction du num semaine (C2), de l'année (D2), et du jour de la semaine (lundi,mardi, mercredi etc....) (B3) me donnerait une date précise.

A savoir que le format de mon num semaine est particulier: S32, S1, etc...

Je vous remercie d'avance pour tout conseil, aide, ou piste.


Bonne soirée


Titine

 

[Banzai64]

Re : Formule: Semaine ISO / année / jour

Bonjour

Une formule de .... adaptée à ton cas

Il doit y avoir mieux

=7*CNUM(STXT(C2;2;10))+DATE(D2;1;3)-JOURSEM(DATE(D2;1;3);2)+EQUIV(B3;{"Lundi";"Mardi";"Mercredi";"Jeudi";"Vendredi";"Samedi";"Dimanche"};0)

jeudi 12 août 2010

 

[ROGER2327]

Re : Formule: Semaine ISO / année / jour

Bonjour à tous

Quelques fonctions fondées sur la représentation des dates dans le système ISO :

[COLOR="DarkSlateGray"][B]Function GRG(r) [COLOR="Sienna"]'Transcription grégorienne d'une date ISO.[/COLOR]
Application.Volatile
Dim x, d1&
  x = Split(r & "-1", "-")
  d1 = DateSerial(x(0), 1, 1)
  GRG = d1 - 7 - Weekday(d1, vbMonday) + (Replace(x(1), "W", "") - (Weekday(d1, vbMonday) > 4)) * 7 + x(2)
End Function

Function ISO(r) [COLOR="Sienna"]'Transcription ISO d'une date grégorienne.[/COLOR]
Application.Volatile
Dim d2&, d3&, d4&
  d2 = r + 1 - Weekday(r, vbMonday)
  d3 = DateSerial(Year(d2 + 3), 1, 1)
  d4 = d3 + 1 - Weekday(d3, vbMonday) - (Weekday(d3, vbMonday) > 4) * 7
  ISO = Year(d3) & "-W" & Format((d2 - d4) \ 7 + 1, "00") & "-" & Weekday(r, vbMonday)
End Function

Function normTITINE(r$) [COLOR="Sienna"]'Transcription "titine" d'une semaine ISO.[/COLOR]
Application.Volatile
  normTITINE = Replace(Replace(Split(r, "-")(1), "W", "S"), "S0", "S") & Space(2) & Split(r, "-")(0)
End Function

Function normTITINE_2(r$)[COLOR="Sienna"] 'Transcription "titine" d'une date grégorienne.[/COLOR]
Application.Volatile
Dim x
  x = Split(r & "-0", "-")
  normTITINE_2 = Array(Trim(Array("", "Lundi", "Mardi", "Mercredi", "Jeudi", "Vendredi", "Samedi", "Dimanche")(x(2)) & _
    " "), Replace(Replace(x(1), "W", "S"), "S0", "S"), x(0))
End Function

Function sISO(r) [COLOR="Sienna"]'Correction d'une date ISO erronée.[/COLOR]
Application.Volatile
Dim x, d1&, d2&, d3&, d4&
  x = Split(r & "-1", "-")
  d1 = DateSerial(x(0), 1, 1)
  d2 = d1 - 6 - Weekday(d1, vbMonday) + (Replace(x(1), "W", "") - (Weekday(d1, vbMonday) > 4)) * 7
  d3 = DateSerial(Year(d2 + 3), 1, 1)
  d4 = d3 + 1 - Weekday(d3, vbMonday) - (Weekday(d3, vbMonday) > 4) * 7
  sISO = Array(Year(d3) & "-W" & Format((d2 - d4) \ 7 + 1, "00") & "-" & x(2), d1, d2, d3, d4)
End Function[/B][/COLOR]

Exemples de mise en œuvre et comparaison des solutions dans le classeur joint.
Post scriptum : La pièce jointe est supprimée. Voir le message suivant.​

ROGER2327
#4327

Vendredi 13 Haha 138 (Saint et Sainte Fenouillard, Sainte famille, SQ)
27 Vendémiaire An CCXIX
2010-W42-1T02:39:36Z

 

[ROGER2327]

Re : Formule: Semaine ISO / année / jour

Suite...

Correction d'une formule :

[COLOR="DarkSlateGray"][B]Function sISO(r) [COLOR="Sienna"]'Correction d'une date ISO erronée.[/COLOR]
Application.Volatile
Dim x, d1&, d2&, d3&, d4&
  x = Split(r & "-1", "-")
  d1 = DateSerial(x(0), 1, 1)
  d2 = d1 - 6 - Weekday(d1, vbMonday) + (Replace(x(1), "W", "") - (Weekday(d1, vbMonday) > 4)) * 7
  d3 = DateSerial(Year(d2 + 3), 1, 1)
  d4 = d3 + 1 - Weekday(d3, vbMonday) - (Weekday(d3, vbMonday) > 4) * 7
  sISO = [U]Year(d3) & "-W" & Format((d2 - d4) \ 7 + 1, "00") & "-" & x(2)[/U]
End Function[/B][/COLOR]

(La version précédente était une version de test.)​

ROGER2327
#4329

Vendredi 13 Haha 138 (Saint et Sainte Fenouillard, Sainte famille, SQ)
27 Vendémiaire An CCXIX
2010-W42-1T09:11:37Z

 

[pierrejean]

Re : Formule: Semaine ISO / année / jour

Bonjour titine06

Salut Banzai
Salut Gros Requin
Salut Roger

Une fonction personnalisée (Avec moult remerciements à ROGER pour le 'jeu d'essai' qui en a permis la mise au point )

 

[Monique]

Re : Formule: Semaine ISO / année / jour

Bonjour ,

Pour raccourcir les 1ères formules proposées :

[FONT=Verdana][FONT=Verdana]=DATE(D2;1;3)-JOURSEM(DATE(D2;1;3))-6+7*STXT(C2;2;2)+EQUIV(STXT(B3;1;2);{"Lu";"Ma";"Me";"Je";"Ve";"Sa";"Di"};0)[/FONT]
[/FONT]

[FONT=Verdana][FONT=Verdana]=DATE(D2;1;3)-JOURSEM(DATE(D2;1;3))-6+7*STXT(C2;2;2)+CHERCHE(STXT(B3;1;2);"ZLuMaMeJeVeSaDi")/2[/FONT]
[/FONT]

 

[ROGER2327]

Re : Formule: Semaine ISO / année / jour

Bonjour à tous

Je vois que le sujet inspire...
pierrejean, vous avez raison, autant aller jusqu'au bout avec VBA, y compris en C3.
Voici ma vision de la chose :

[COLOR="DarkSlateGray"][B]Function TITINE(j, s$, a%) [COLOR="Sienna"]'Utilise la fonction ISO().[/COLOR]
Application.Volatile
Dim d1&
  Select Case IsNumeric(j)
  Case True: j = j * (0 < CInt(j)) * (CInt(j) < 8)
  Case False: j = InStr(1, "#lumamejevesadi", Left$(Replace(j, ".", ""), 2), vbTextCompare) / 2
  End Select
  s = Replace(s, "S", "", , , vbTextCompare)
  If s Like "#*" Then s = Val(s) Else s = 0
  If 1900 >= a Or a >= 9999 Then a = 0
  If j * s * a <> 0 Then
    d1 = DateSerial(a, 1, 1)
    d1 = d1 - 7 - Weekday(d1, vbMonday) + (s - (Weekday(d1, vbMonday) > 4)) * 7 + j
  End If
  If ISO(d1) = a & "-W" & Format(s, "00") & "-" & j Then TITINE = d1 Else TITINE = ""
End Function[/B][/COLOR]

Mettre =TITINE(B3;C2;D2) en C3.

Je joins le fichier de travail enrichi des contributions de Monique et de pierrejean.​

ROGER2327
#4331

Vendredi 13 Haha 138 (Saint et Sainte Fenouillard, Sainte famille, SQ)
27 Vendémiaire An CCXIX
2010-W42-1T13:42:17Z

 

[pierrejean]

Re : Formule: Semaine ISO / année / jour

Re

J'admets volontiers la superiorité de la TITINE de ROGER

J'ai un petit peu simplifié ma pierrejean et fait en sorte qu'elle n'affiche pas de sottise dans les cas anormaux cités et je me satisfait bien d'avoir une fonction personnalisée du niveau des formules de MONIQUE (a qui j'adresse mes hommages vespéraux)

 

[titine06]

Re : Formule: Semaine ISO / année / jour

Bonsoir à tous,

Je suis très agréablement surpris en voyant le nombre de réponse et d'investissement qui ont suivis à ce poste ! Mon seul regret est que j'arrive encore une fois après la bataille !

Une fonction à mon nom !! J'en revais, Roger l'a fait !!
Cette fonction répond exactement à problématique qui n'en est plus d'ailleurs de plus, les diverses cas sur le fichier m'aideront grandement dans mon projet !

mille fois merci !! encore !



Titine

 

[ROGER2327]

Re : Formule: Semaine ISO / année / jour

Re...

(...)
Une fonction à mon nom !! J'en revais, Roger l'a fait !!
(...)

Rendons à César ce qui appartient à César, et à pierrejean ce qui revient à pierrejean !
C'est lui le créateur de votre fonction très personnelle, et je ne fais qu'y apporter mon grain de sel.

Si vous avez regardé de près le classeur d'essai, vous avez constaté que, lorsque les données sont correctes, les solutions de Monique et de pierrejean donnent les mêmes résultats.

En voici une autre, qui fait la même chose que la précédente, mais sans utiliser la fonction ISO :

[COLOR="DarkSlateGray"][B]Function TITINE(j, s$, a%)
Application.Volatile
Dim d1&, jd%
  TITINE = ""
  Select Case IsNumeric(j)
  Case True: j = j * (0 < CInt(j)) * (CInt(j) < 8)
  Case False: j = InStr(1, "#lumamejevesadi", Left$(Replace(j, ".", ""), 2), vbTextCompare) / 2
  End Select
  If 1900 >= a Or a >= 9999 Then a = 0
  d1 = DateSerial(a, 1, 1)
  jd = Weekday(d1, vbMonday)
  s = Replace(s, "S", "", , , vbTextCompare)
  If s Like "#*" Then s = Val(s) Else s = 0
  If 1 > s Or s > 52 - (jd = 4 Or ((jd = 3) And ((((a Mod 4) = 0) - ((a Mod 100) = 0) + ((a Mod 400) = 0))) = -1)) Then s = 0
  If j * s * a <> 0 Then TITINE = d1 - 7 - jd + (s - (jd > 4)) * 7 + j
End Function[/B][/COLOR]

ROGER2327
#4342

Vendredi 13 Haha 138 (Saint et Sainte Fenouillard, Sainte famille, SQ)
27 Vendémiaire An CCXIX
2010-W42-1T23:55:46Z

 

[titine06]

Re : Formule: Semaine ISO / année / jour

Oups! Decidement... La reine de la gaf..!
Un grand merci egalement a monique et pierrejean!!!

A bientot!

Titine