OVH Cloud OVH Cloud

Nombre de vendredi dans un mois

38 réponses
Avatar
Tatanka
Bonjour,

En ce mois d'octobre 2010, il y a 5 « vendredi »,
5 « samedi » et 5 « dimanche ». Un fait rarissime.
Question 1 :
Comment faire pour obtenir le nombre de vendredi, samedi, dimanche ...
d'un mois et d'une année donnés.
Question 2 :-))
Une tite macro qui donnerait le nombre de dimanche, lundi, mardi, mercredi, jeudi,
vendredi et samedi pour chaque mois de toutes les années du calendrier julien.

A+
Serge

10 réponses

1 2 3 4
Avatar
isabelle
salut Serge

Le 2010-10-22 15:50, Tatanka a écrit :
Bonjour,

En ce mois d'octobre 2010, il y a 5 « vendredi »,
5 « samedi » et 5 « dimanche ». Un fait rarissime.



rarissime j'en doute mais avec les années bissex c'est pas facille de trouver une constance
http://cjoint.com/?0kxsdkaJ8aN

isabelle
Avatar
isabelle
plus visuel, http://cjoint.com/?0kxsrKpME6x
isabelle

Le 2010-10-23 12:04, isabelle a écrit :
salut Serge

Le 2010-10-22 15:50, Tatanka a écrit :
Bonjour,

En ce mois d'octobre 2010, il y a 5 « vendredi »,
5 « samedi » et 5 « dimanche ». Un fait rarissime.



rarissime j'en doute mais avec les années bissex c'est pas facille de
trouver une constance
http://cjoint.com/?0kxsdkaJ8aN

isabelle
Avatar
Modeste
Bonsour®

"michdenis" a écrit dans
***Excuse-toi pas, sois plus précis la prochaine fois ! ;-)

| il suffit de d'ajouter 28 ans aux dates déjà connues (*) ,
| pour qu'une même date corresponde au même jour de la semaine

Si tu continues à expliquer, je finirai bien par comprendre !



Dans le calendrier julien, les jours de la semaine se retrouvent aux mêmes dates
au bout de 28 ans et notamment les dimanches, jours consacrés autrefois au
Soleil.
http://villemin.gerard.free.fr/Scienmod/Calendri.htm#Cycle28

;o)))
Avatar
Tatanka
Avec ma macro qui s'arrête à tout bout de champ,
j'obtiens 80 occurences du phénomène :

1) mars 1946
2) août 1947
...
79) mars 2024
80) août 2025

Serge


"michdenis" a écrit dans le message de news: i9utmj$5fg$

Essaie ceci :

Affiche dans la colonne A, le mois et l'année comprise entre
le 1 janvier 1945 et le 31 décembre 2025 où il y a 5 Vendredis
5 Samedis et 5 dimanches.

Sauf erreur, il y aurait eu 86 occurrences du phénomène!

'---------------------------------------
Sub Test()

Dim DateFin As Date, DateDebut As Date
Dim Arr(), Elt As Variant, Nb As Integer
Dim A As Integer, B As Integer, Tblo()
Dim Message As String, C As Integer

Arr = Array(5, 6, 7)

For A = 1945 To 2025
For B = 1 To 12
DateFin = DateSerial(A, B + 1, 0)
DateDebut = DateSerial(A, B, 1)
For Each Elt In Arr
x = Evaluate("INT((" & DateFin * 1 & "-MOD(" & DateFin * 1 & _
"-6," & Elt & ")-" & DateDebut * 1 & "+7)/7)")
If x <> 5 Then
Exit For
Else
C = C + 1
End If
Next
If C = 3 Then
Nb = Nb + 1
ReDim Preserve Tblo(1 To Nb)
Tblo(Nb) = "Mois: " & B & " année: " & A & vbCrLf
End If
C = 0
Next
Next
Range("A1").Resize(UBound(Tblo)) = Application.Transpose(Tblo)
Range("A1").EntireColumn.AutoFit
Application.ScreenUpdating = True
End Sub
'---------------------------------------

--
MichD
--------------------------------------------


"Tatanka" a écrit dans le message de groupe de discussion :
i9up2m$p2h$
Merci à tous pour vos précieux conseils.
J'ai concocté une macro qui donne la liste de tous les mois
contenant 5 fins de semaine de 1945 è 2010 (pas rare pantoute).
Elle me semble compétente mais s'arrête souvent et je dois cliquer sur Continuer.
Cette macro est associée au rectangle bleu du classeur ci-joint :
http://www.cijoint.fr/cjlink.php?file=cj201010/cijf8gbEKT.xls

Pourquoi ces nombreuses interruptions ?
Vous semble-t-elle compétente ?
Autre façon de faire sans utilliser les formules de la feuille de calcul ?

A+
Serge

Avatar
michdenis
Merci pour cette adresse.

--
MichD
--------------------------------------------


"Modeste" a écrit dans le message de groupe de discussion : 4cc3313a$0$9849$
Bonsour®

"michdenis" a écrit dans
***Excuse-toi pas, sois plus précis la prochaine fois ! ;-)

| il suffit de d'ajouter 28 ans aux dates déjà connues (*) ,
| pour qu'une même date corresponde au même jour de la semaine

Si tu continues à expliquer, je finirai bien par comprendre !



Dans le calendrier julien, les jours de la semaine se retrouvent aux mêmes dates
au bout de 28 ans et notamment les dimanches, jours consacrés autrefois au
Soleil.
http://villemin.gerard.free.fr/Scienmod/Calendri.htm#Cycle28

;o)))
Avatar
michdenis
Il y avait une petite erreur dans ma procédure :

Vendredi, Samedi, Dimanche représente 6, 7, 1
et non ce que j'avais considéré dans cette variable
Arr = Array(6, 7, 1) et non Arr = Array(5, 6, 7) comme
l'énonçait la procédure précédente.


Résultat, la procédure compte 150 occurrences entre
1945 et 2025

'--------------------------------------------
Sub Test()

Dim DateFin As Date, DateDebut As Date
Dim Arr(), Elt As Variant, Nb As Integer
Dim A As Integer, B As Integer, Tblo()
Dim Message As String, C As Integer

Arr = Array(6, 7, 1)

For A = 1945 To 2025
For B = 1 To 12
DateFin = DateSerial(A, B + 1, 0)
DateDebut = DateSerial(A, B, 1)
For Each Elt In Arr
x = Evaluate("INT((" & DateFin * 1 & "-MOD(" & DateFin * 1 & _
"-6," & Elt & ")-" & DateDebut * 1 & "+7)/7)")
If x <> 5 Then
Exit For
Else
C = C + 1
End If
Next
If C = 3 Then
Nb = Nb + 1
ReDim Preserve Tblo(1 To Nb)
Tblo(Nb) = "Mois: " & B & " année: " & A & vbCrLf
End If
C = 0
Next
Next
Range("A1").Resize(UBound(Tblo)) = Application.Transpose(Tblo)
Range("A1").EntireColumn.AutoFit
Application.ScreenUpdating = True
End Sub
'--------------------------------------------

--
MichD
--------------------------------------------


"Tatanka" a écrit dans le message de groupe de discussion :
i9vev1$ban$
Avec ma macro qui s'arrête à tout bout de champ,
j'obtiens 80 occurences du phénomène :

1) mars 1946
2) août 1947
...
79) mars 2024
80) août 2025

Serge


"michdenis" a écrit dans le message de news: i9utmj$5fg$

Essaie ceci :

Affiche dans la colonne A, le mois et l'année comprise entre
le 1 janvier 1945 et le 31 décembre 2025 où il y a 5 Vendredis
5 Samedis et 5 dimanches.

Sauf erreur, il y aurait eu 86 occurrences du phénomène!

'---------------------------------------
Sub Test()

Dim DateFin As Date, DateDebut As Date
Dim Arr(), Elt As Variant, Nb As Integer
Dim A As Integer, B As Integer, Tblo()
Dim Message As String, C As Integer

Arr = Array(5, 6, 7)

For A = 1945 To 2025
For B = 1 To 12
DateFin = DateSerial(A, B + 1, 0)
DateDebut = DateSerial(A, B, 1)
For Each Elt In Arr
x = Evaluate("INT((" & DateFin * 1 & "-MOD(" & DateFin * 1 & _
"-6," & Elt & ")-" & DateDebut * 1 & "+7)/7)")
If x <> 5 Then
Exit For
Else
C = C + 1
End If
Next
If C = 3 Then
Nb = Nb + 1
ReDim Preserve Tblo(1 To Nb)
Tblo(Nb) = "Mois: " & B & " année: " & A & vbCrLf
End If
C = 0
Next
Next
Range("A1").Resize(UBound(Tblo)) = Application.Transpose(Tblo)
Range("A1").EntireColumn.AutoFit
Application.ScreenUpdating = True
End Sub
'---------------------------------------

--
MichD
--------------------------------------------


"Tatanka" a écrit dans le message de groupe de discussion :
i9up2m$p2h$
Merci à tous pour vos précieux conseils.
J'ai concocté une macro qui donne la liste de tous les mois
contenant 5 fins de semaine de 1945 è 2010 (pas rare pantoute).
Elle me semble compétente mais s'arrête souvent et je dois cliquer sur Continuer.
Cette macro est associée au rectangle bleu du classeur ci-joint :
http://www.cijoint.fr/cjlink.php?file=cj201010/cijf8gbEKT.xls

Pourquoi ces nombreuses interruptions ?
Vous semble-t-elle compétente ?
Autre façon de faire sans utilliser les formules de la feuille de calcul ?

A+
Serge

Avatar
michdenis
Merci Tatanka,

voici une correction importante de mes messages précédents
sur ce fil. Après correction, j'obtiens les mêmes dates que toi
entre l'année 1945 et 2025

La formule utilisée était incorrecte. Voilà la formule que j'aurais dû employer.
L8 étant la date de fin et M8 la date de début
Basée sur la formule de Daniel Maher.
=SOMME(ENT((L8-JOURSEM(L8-{0;5;6})-M8+8)/7))

La procédure aurait dû être ceci :
'--------------------------------------------
Sub Test()
Dim DateFin As Date, DateDebut As Date
Dim Nb As Integer, Message As String
Dim A As Integer, B As Integer, Tblo()
Dim X As Integer

For A = 1945 To 2025
For B = 1 To 12
DateFin = DateSerial(A, B + 1, 0)
DateDebut = DateSerial(A, B, 1)
X = Evaluate("SUM(INT((" & DateFin * 1 & _
"-WEEKDAY(" & DateFin * 1 & "-{0;5;6})-" & _
DateDebut * 1 & "+8)/7))")
If X = 15 Then
Nb = Nb + 1
ReDim Preserve Tblo(1 To Nb)
Tblo(Nb) = "Mois: " & B & " année: " & A & vbCrLf
End If
Next
Next
Range("K1").Resize(UBound(Tblo)) = Application.Transpose(Tblo)
Range("K1").EntireColumn.AutoFit
Application.ScreenUpdating = True
End Sub
'--------------------------------------------

--
MichD
--------------------------------------------
Avatar
Tatanka
Bonjour,

Et voici enfin une macro qui ne s'arrête pas sans cesse et
qui ne se réfère pas aux formules d'une feuille de calcul.
Elle s'inspire de la remarque de Michel :
« Si c'est pour retrouver ces mois à 5 week-ends, il faut chercher les
mois de
31 jours commençant un vendredi ».
Croyez-vous que cette façon de faire est valable pour des années
antérieures à 1904 ?

Sub Liste()
Sheets.Add
mois = Array("janvier", "février", "mars", "avril", _
"mai", "juin", "juillet", "août", "septembre", "octobre", _
"novembre", "décembre")
m = Array(1, 3, 5, 7, 8, 10, 12) 'Mois de 31 jours
Application.ScreenUpdating = False
For i = 1945 To 2025
For j = 0 To 6
If (Format(DateSerial(i, m(j), 1), "dddd") _
= "vendredi") Then
k = k + 1
Cells(k, 1) = mois(m(j) - 1)
Cells(k, 2) = i
End If
Next j
Next i
Application.ScreenUpdating = True
End Sub

Bonne journée et A+
Serge


On 23 oct, 09:48, "Tatanka" wrote:
Merci à tous pour vos précieux conseils.
J'ai concocté une macro qui donne la liste de tous les mois
contenant 5 fins de semaine de 1945 è 2010 (pas rare pantoute).
Elle me semble compétente mais s'arrête souvent et je dois cliquer su r Continuer.
Cette macro est associée au rectangle bleu du classeur ci-joint :http:/ /www.cijoint.fr/cjlink.php?file=cj201010/cijf8gbEKT.xls

Pourquoi ces nombreuses interruptions ?
Vous semble-t-elle compétente ?
Autre façon de faire sans utilliser les formules de la feuille de calcu l ?

A+
Serge
Avatar
michdenis
| Croyez-vous que cette façon de faire est valable
| pour des années antérieures à 1904 ?

Les fonctions VBA peuvent traiter les dates allant de l'an 100
à 9999, ce n'est évidemment pas le cas pour les fonctions de la
feuille de calcul. Si tu recules assez loin en arrière, il faudra tenir
compte de l'évolution du calendrier que l'on connaît aujourd'hui.

--
MichD
--------------------------------------------


"Tatanka" a écrit dans le message de groupe de discussion :

Bonjour,

Et voici enfin une macro qui ne s'arrête pas sans cesse et
qui ne se réfère pas aux formules d'une feuille de calcul.
Elle s'inspire de la remarque de Michel :
« Si c'est pour retrouver ces mois à 5 week-ends, il faut chercher les
mois de
31 jours commençant un vendredi ».
Croyez-vous que cette façon de faire est valable pour des années
antérieures à 1904 ?

Sub Liste()
Sheets.Add
mois = Array("janvier", "février", "mars", "avril", _
"mai", "juin", "juillet", "août", "septembre", "octobre", _
"novembre", "décembre")
m = Array(1, 3, 5, 7, 8, 10, 12) 'Mois de 31 jours
Application.ScreenUpdating = False
For i = 1945 To 2025
For j = 0 To 6
If (Format(DateSerial(i, m(j), 1), "dddd") _
= "vendredi") Then
k = k + 1
Cells(k, 1) = mois(m(j) - 1)
Cells(k, 2) = i
End If
Next j
Next i
Application.ScreenUpdating = True
End Sub

Bonne journée et A+
Serge


On 23 oct, 09:48, "Tatanka" wrote:
Merci à tous pour vos précieux conseils.
J'ai concocté une macro qui donne la liste de tous les mois
contenant 5 fins de semaine de 1945 è 2010 (pas rare pantoute).
Elle me semble compétente mais s'arrête souvent et je dois cliquer sur Continuer.
Cette macro est associée au rectangle bleu du classeur ci-joint
:http://www.cijoint.fr/cjlink.php?file=cj201010/cijf8gbEKT.xls

Pourquoi ces nombreuses interruptions ?
Vous semble-t-elle compétente ?
Autre façon de faire sans utilliser les formules de la feuille de calcul ?

A+
Serge
Avatar
Tatanka
Ok merci,

102 cas de 1900 à 2000 :

15 en janvier
15 en mars
15 en mai
14 en juillet
14 en août
14 en octobre
15 en décembre

Là je crois que le sujet est clos :-)

Serge


"michdenis" a écrit dans le message de news: ia4ehp$j9o$
| Croyez-vous que cette façon de faire est valable
| pour des années antérieures à 1904 ?

Les fonctions VBA peuvent traiter les dates allant de l'an 100
à 9999, ce n'est évidemment pas le cas pour les fonctions de la
feuille de calcul. Si tu recules assez loin en arrière, il faudra tenir
compte de l'évolution du calendrier que l'on connaît aujourd'hui.

--
MichD
--------------------------------------------


"Tatanka" a écrit dans le message de groupe de discussion :

Bonjour,

Et voici enfin une macro qui ne s'arrête pas sans cesse et
qui ne se réfère pas aux formules d'une feuille de calcul.
Elle s'inspire de la remarque de Michel :
« Si c'est pour retrouver ces mois à 5 week-ends, il faut chercher les
mois de
31 jours commençant un vendredi ».
Croyez-vous que cette façon de faire est valable pour des années
antérieures à 1904 ?

Sub Liste()
Sheets.Add
mois = Array("janvier", "février", "mars", "avril", _
"mai", "juin", "juillet", "août", "septembre", "octobre", _
"novembre", "décembre")
m = Array(1, 3, 5, 7, 8, 10, 12) 'Mois de 31 jours
Application.ScreenUpdating = False
For i = 1945 To 2025
For j = 0 To 6
If (Format(DateSerial(i, m(j), 1), "dddd") _
= "vendredi") Then
k = k + 1
Cells(k, 1) = mois(m(j) - 1)
Cells(k, 2) = i
End If
Next j
Next i
Application.ScreenUpdating = True
End Sub

Bonne journée et A+
Serge


On 23 oct, 09:48, "Tatanka" wrote:
Merci à tous pour vos précieux conseils.
J'ai concocté une macro qui donne la liste de tous les mois
contenant 5 fins de semaine de 1945 è 2010 (pas rare pantoute).
Elle me semble compétente mais s'arrête souvent et je dois cliquer sur Continuer.
Cette macro est associée au rectangle bleu du classeur ci-joint
:http://www.cijoint.fr/cjlink.php?file=cj201010/cijf8gbEKT.xls

Pourquoi ces nombreuses interruptions ?
Vous semble-t-elle compétente ?
Autre façon de faire sans utilliser les formules de la feuille de calcul ?

A+
Serge



1 2 3 4