OVH Cloud OVH Cloud

Nombre de vendredi 13 de ma naissance jusqu'à aujourdhui

34 réponses
Avatar
Tatanka
Bonsoir,

J'ai adapté une macro trouvée ici :
http://www.docmemo.com/divers/vendredi13.php

me permettant d'obtenir la liste de tous les « vendredi 13 »
de 1945 jusqu'à 2011. Le résultat me satisfait mais par
souci d'apprentissage, comment la modifier pour que cette
liste ne couvre que la période du 10 mai 1945 jusqu'à
la date du jour ? Voici la macro :

Sub Vendredi_13()
Dim Année, Mois, Compteur, NomMois(12)
NomMois(1) = "janvier"
NomMois(2) = "février"
NomMois(3) = "mars"
NomMois(4) = "avril"
NomMois(5) = "mai"
NomMois(6) = "juin"
NomMois(7) = "juillet"
NomMois(8) = "août"
NomMois(9) = "septembre"
NomMois(10) = "octobre"
NomMois(11) = "novembre"
NomMois(12) = "décembre"
For Année = 1945 To 2011
For Mois = 1 To 12
If Weekday(Mois & "/13/" & Année) = 6 Then
Range("A1").Offset(Compteur, 0) = "13 " _
& NomMois(Mois) & " " & Année
Compteur = Compteur + 1
End If
Next Mois
Next Année
End Sub

10 réponses

1 2 3 4
Avatar
Tatanka
;-)))

En effet, ça serait beaucoup plus important de calculer le nombre de lundi 13 !

Serge

"DanielCo" a écrit dans le message de news: ihhfij$i17$
La plus rapide ( mais qu'est-ce qu'on s'en fout :-) ) :



... de calculer un nombre de vendredi 13 aussi, note bien.
;-)))
Daniel


Avatar
Tatanka
J'ai redémarré l'ordi et cette fois-ci, toutes les macros
s'exécutent, mais en 14 s ! plutôt qu'en moins de 1 s !!!

Serge

"Jacky" a écrit dans le message de news: ihhgtq$l9g$
Comme quoi........les "vendredi 13"
Reboote ton pc

--
Salutations
JJ


"Tatanka" a écrit dans le message de news: ihhge6$k5f$
Encore pire !!!
Toutes les macros proposées renvoient « Exécution interrompue »
quand je les appelle pourtant poliment !
C'est quoi ça ? ;-)

Serge






Avatar
Modeste
Bonsour®

ramanujan
a écrit
En effet, ça serait beaucoup plus important de calculer le nombre de lundi 13
!



bedon les lundi 24 janv...
mais ça c'est pour demain !!!

Sub jacquouille()
debut = 1948
Z$ = "happy birthday jacquouille"
x = 1: y = 0
d = GetTickCount
While newdate < Date
newdate = DateSerial(debut, x, 24)
' ----- !!!!!!! instruction excel 2007+
Application.Speech.Speak y
x = x + 12: y = y + 1
Wend
MsgBox (GetTickCount - d) / 1000 & " sec", , Z
Application.Speech.Speak Z$
End Sub

;o)))
Avatar
Jacquouille
Ah Sommeprod, quelle symphonie, et ....quelle rapidité

--
Jacquouille

" Le vin est au repas ce que le parfum est à la femme."

"michdenis" a écrit dans le message de groupe de
discussion : ihhco6$beu$
Bonjour,

Si tu veux seulement calculer le nombre de vendredi 13 entre 2 dates

Debut : Nom de la cellule contenant la date du début
Fin : Nom de la cellule contenant la date de la fin

=SOMMEPROD(((JOUR(LIGNE(INDIRECT(Debut&":"&Fin))))*(((JOURSEM(LIGNE(INDIRECT(Debut&":"&Fin));1)=6)))))

OU

Validation matricielle :
=SOMME(SI(((JOUR(LIGNE(INDIRECT(Debut&":"&Fin))))*(((JOURSEM(LIGNE(INDIRECT(Debut&":"&Fin));1)=6)*1)))=1;1))


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

Avatar
michdenis
Si tu recherches la vitesse, il y a aussi ceci :

'Déclaration de l'Api dans le haut du module :
Declare Function GetTickCount& Lib "kernel32" ()
'--------------------------------------------
Sub Liste_Vendredi_13()
Dim Année As Long, T(), A As Long
Dim Debut As Long, Fin As Long, D As Long

D = GetTickCount
Debut = CDate("22/03/1954")
Fin = Date

For Année = Debut To Fin
If Weekday(Année) = 6 And Day(Année) = 13 Then
ReDim Preserve T(A)
T(A) = Année
A = A + 1
End If
Next
Application.ScreenUpdating = False
Application.EnableEvents = False
With Range("A1").Resize(UBound(T) + 1)
.NumberFormat = "dddd dd mmmm yyyy"
.Value = Application.Transpose(T)
.EntireColumn.AutoFit
End With
Application.ScreenUpdating = True
Application.EnableEvents = True
MsgBox (GetTickCount - D) / 1000 & " sec"
End Sub
'--------------------------------------------


MichD
--------------------------------------------
Avatar
Jacquouille
108 demain matin, (des vendredi 13 ....)
Bonjour et grand merci à toi, Gilbert, de te soucier de ma ride
supplémentaire. -)

--
Jacquouille

" Le vin est au repas ce que le parfum est à la femme."

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

bedon les lundi 24 janv...
mais ça c'est pour demain !!!

Sub jacquouille()
debut = 1948
Z$ = "happy birthday jacquouille"
x = 1: y = 0
d = GetTickCount
While newdate < Date
newdate = DateSerial(debut, x, 24)
' ----- !!!!!!! instruction excel 2007+
Application.Speech.Speak y
x = x + 12: y = y + 1
Wend
MsgBox (GetTickCount - d) / 1000 & " sec", , Z
Application.Speech.Speak Z$
End Sub

;o)))
Avatar
Tatanka
C'est à n'y rien comprendre ( en tous cas pour moi ).
J'ai copié toutes les macros dans un nouveau classeur
et elles s'exécutent à nouveau en des temps records.

Serge

"Tatanka" a écrit dans le message de news: ihhhkv$n84$
J'ai redémarré l'ordi et cette fois-ci, toutes les macros
s'exécutent, mais en 14 s ! plutôt qu'en moins de 1 s !!!

Serge

"Jacky" a écrit dans le message de news: ihhgtq$l9g$
Comme quoi........les "vendredi 13"
Reboote ton pc

--
Salutations
JJ


"Tatanka" a écrit dans le message de news: ihhge6$k5f$
Encore pire !!!
Toutes les macros proposées renvoient « Exécution interrompue »
quand je les appelle pourtant poliment !
C'est quoi ça ? ;-)

Serge










Avatar
Péhemme
Joyeux zanni Jacquouille
Michel

"Jacquouille" a écrit dans le message de
news:4d3c58e1$0$14256$
108 demain matin, (des vendredi 13 ....)
Bonjour et grand merci à toi, Gilbert, de te soucier de ma ride
supplémentaire. -)

--
Jacquouille

" Le vin est au repas ce que le parfum est à la femme."

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



bedon les lundi 24 janv...
mais ça c'est pour demain !!!

Sub jacquouille()
debut = 1948
Z$ = "happy birthday jacquouille"
x = 1: y = 0
d = GetTickCount
While newdate < Date
newdate = DateSerial(debut, x, 24)
' ----- !!!!!!! instruction excel 2007+
Application.Speech.Speak y
x = x + 12: y = y + 1
Wend
MsgBox (GetTickCount - d) / 1000 & " sec", , Z
Application.Speech.Speak Z$
End Sub

;o)))



Avatar
michel ou sam
Bonjour,
en reprenant ta macro, j'ai réussi à gagner qq ms en sachant que tous les 28
ans (10227 jours) ça se répète
de 47 ms je suis passé à 31 ms
Bon, il y aura des précautions à prendre si on change de date.

Sub Vendredi_13modif()
Dim Année As Long, T(), A As Long
Dim Debut As Long, Fin As Long, D As Long
D = GetTickCount
Debut = CDate("22/03/1954")
Final = Date
Fin = Application.WorksheetFunction.Min(Final, Debut + 10227)
For Année = Debut To Fin
If Weekday(Année) = 6 And Day(Année) = 13 Then
ReDim Preserve T(A)
T(A) = Année
A = A + 1
End If
Next
Année = T(A - 48) + 10227
While Année < Final
ReDim Preserve T(A)
T(A) = Année
A = A + 1
Année = T(A - 48) + 10227
Wend
Application.ScreenUpdating = False
Application.EnableEvents = False
With Range("B1").Resize(UBound(T) + 1)
.NumberFormat = "dddd dd mmmm yyyy"
.Value = Application.Transpose(T)
.EntireColumn.AutoFit
End With
Application.ScreenUpdating = True
Application.EnableEvents = True
Range("B100") = (GetTickCount - D) / 1000 & " sec"

Michel

"michdenis" a écrit dans le message de news:
ihhj47$rgf$
Si tu recherches la vitesse, il y a aussi ceci :

'Déclaration de l'Api dans le haut du module :
Declare Function GetTickCount& Lib "kernel32" ()
'--------------------------------------------
Sub Liste_Vendredi_13()
Dim Année As Long, T(), A As Long
Dim Debut As Long, Fin As Long, D As Long

D = GetTickCount
Debut = CDate("22/03/1954")
Fin = Date

For Année = Debut To Fin
If Weekday(Année) = 6 And Day(Année) = 13 Then
ReDim Preserve T(A)
T(A) = Année
A = A + 1
End If
Next
Application.ScreenUpdating = False
Application.EnableEvents = False
With Range("A1").Resize(UBound(T) + 1)
.NumberFormat = "dddd dd mmmm yyyy"
.Value = Application.Transpose(T)
.EntireColumn.AutoFit
End With
Application.ScreenUpdating = True
Application.EnableEvents = True
MsgBox (GetTickCount - D) / 1000 & " sec"
End Sub
'--------------------------------------------


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

Avatar
Jacquouille
Merci Michel
Tu as bien raison de t'accrocher...

--
Jacquouille

" Le vin est au repas ce que le parfum est à la femme."

"Péhemme" a écrit dans le message de groupe de discussion :
4d3c6039$0$7712$
Joyeux zanni Jacquouille
Michel

"Jacquouille" a écrit dans le message de
news:4d3c58e1$0$14256$
108 demain matin, (des vendredi 13 ....)
Bonjour et grand merci à toi, Gilbert, de te soucier de ma ride
supplémentaire. -)

--
Jacquouille

" Le vin est au repas ce que le parfum est à la femme."

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



bedon les lundi 24 janv...
mais ça c'est pour demain !!!

Sub jacquouille()
debut = 1948
Z$ = "happy birthday jacquouille"
x = 1: y = 0
d = GetTickCount
While newdate < Date
newdate = DateSerial(debut, x, 24)
' ----- !!!!!!! instruction excel 2007+
Application.Speech.Speak y
x = x + 12: y = y + 1
Wend
MsgBox (GetTickCount - d) / 1000 & " sec", , Z
Application.Speech.Speak Z$
End Sub

;o)))






1 2 3 4