Jour et numéro de la sem. d'un mois sur une période comprise entre 2 dates

Bonjour,

Je galère avec les dates.

Deux dates. La date de début donne le départ de la période. Elle est censée donner comme indications le jour de la semaine et le numéro de la semaine dans le mois.

La deuxième date donne la fin de la période.

J'ai créé un exemple dans le fichier joint. Dans l'exemple, je cible les vendredis de la dernière semaine de chaque mois entre deux dates.

J'attends une solution en vba en priorité.

Merci pour le coup de pouce.

Cordialement

21exemple-ddetp.xlsx (11.12 Ko)

Bonjour,

voici un exemple

jr = Array("", "Dimanche", "Lundi", "Mardi", "Mercredi", "Jeudi", "Vendredi", "Samedi")
NbrSemMois = Int(Cells(6, 3) - Cells(6, 2)) / 7
jour = jr(Weekday(Cells(6, 2)))

Bonjour Isabelle,

Merci pour ta réponse.

Ca ne répond qu'à une petite partie de ma demande.

Dans mon projet je travaille avec des DtPicker mais peut importe.

Pour plus de clarté, je vais décomposer ma demande.

Voici ce que j'attends.

Trouver le code qui avec une boucle devrait me permettre d'obtenir successivement les dates suivantes (toutes les dates sont des vendredis). Le point de départ étant le 22/06/2019

22/03/2019

36/04/2019

24/05/2019

28/06/2019

La difficulté, c'est que les mois n'ont pas tous la même durée. S'il suffisait d'ajouter 30 jours ça serait facile.

1) Connaitre le jour de la semaine afin d'obtenir le même jour le mois suivant.

Ton code répond parfaitement

jr = Array("", "Dimanche", "Lundi", "Mardi", "Mercredi", "Jeudi", "Vendredi", "Samedi")
NbrSemMois = Int(Cells(6, 3) - Cells(6, 2)) / 7
jour = jr(Weekday(Cells(6, 2)))

2) Connaitre le nombre de mois entre les deux dates pour faire une boucle d'inscription

Exemple :

Entre le 30/06/2019 et le 22/02/2019

Ce code le permet :

NbMois=DateDiff("m", Cells(3,"B"), Cells(3,"C"))

Cependant, je n'arrive pas à concrétiser pour obtenir le résultat.

Pour arriver aux dates finales, est-ce qu'il ne faudrait pas un calcul intermédiaire qui détermine la semaine dans le mois.

Qu'en penses-tu?

Exemple :

22/02/2019 serait égale à 4 (pour la 4ème semaine)

02/02/2019 serait égale à 1 (pour la 1ère semaine)

Merci du temps consacré.

Bonjour ddetp88,

Voyez si les formules, que même Excel peut interpréter correctement,

du fichier joint peuvent vous aider à en déduire le code VBA,

ou aider quelqu'un d'autre

bonjour njhub,

Merci pour ta contribution.

Je crains ne pas pouvoir utiliser ton travail.

Voici ce que j'obtiens à l'ouverture du fichier.

img1

Cordialement

re,

à tester,

re,

Je viens de suivre ton code pas à pas et je ne comprends pas pourquoi le mois de juin n'est affiché.

J'ai mis le vendredi 22 février en date de début et le vendredi 28 juin en date de fin.

img1

ce qui fiche dedans c'est qu'il y a des mois avec 5 vendredis (exemple le mois de mai)

J'ai modifié ton code en prenant la date de départ càd 22/02/2019 comme référence.

Dans ce cas c'est le 4ème vendredi qui est pris.

Le code modifié:

Sub Test_Vendredi()
jr = Array("", "Dimanche", "Lundi", "Mardi", "Mercredi", "Jeudi", "Vendredi", "Samedi")
rw = ActiveSheet.Cells(Rows.Count, "C").End(xlUp).Row + 1
NbMois = DateDiff("m", Cells(3, "B"), Cells(3, "C"))

For i = 1 To NbMois
    m = DateSerial(Year(Cells(3, "B")), Month(Cells(3, "B")) + i, Day(Cells(3, "B")))
    Select Case Weekday(m) ' jour de la semaine: 1=dimanche,2=lundi ,etc
        Case 1: dt = m + 5
        Case 2: dt = m + 4
        Case 3: dt = m + 3
        Case 4: dt = m + 2
        Case 5: dt = m + 1
        Case 6: dt = m + 0
        Case 7: dt = m - 1
        Case Else: dt = ""
    End Select

   Cells(rw, "C").Value = dt
'   Cells(rw, "D").Value = jr(Weekday(dt))
'   Cells(rw + 1, "B").Value = m + 1 'dt + 1

   rw = ActiveSheet.Cells(Rows.Count, "C").End(xlUp).Row + 1
Next i
End Sub

Le résultat

img1

ce qui me ramène à mon premier commentaire:

Pour arriver aux dates finales, est-ce qu'il ne faudrait pas un calcul intermédiaire qui détermine la semaine dans le mois.

Qu'en penses-tu?

Exemple :

22/02/2019 serait égale à 4 (pour la 4ème semaine)

02/02/2019 serait égale à 1 (pour la 1ère semaine)

Cordialement

re,

qu'est ce qui détermine si ça doit être un mois de 28 jour ou autre ?

Bonjour ddetp88,

à coller en C6 et étendre vers le bas tant que nécessaire

=SI(B6="";"";SI(JOUR(B6)>=28;"S5";"S4";""))

Re njhub,

Merci pour ton aide mais je souhaite une proposition en vba.

Isabelle,

Les dates de départ et de fin déterminent les mois. Donc dans mon exemple

Date de départ correspondant au mois de février 28 jours

le mois suivant mars 31 jours, etc...

Je ne sais quoi te répondre d'autre.

Merci encore pour le temps que tu m'accordes.

re,

à tester,

Sub Test_Vendredi()
jr = Array("", "Dimanche", "Lundi", "Mardi", "Mercredi", "Jeudi", "Vendredi", "Samedi")
rw = ActiveSheet.Cells(Rows.Count, "C").End(xlUp).Row + 1
NbMois = DateDiff("m", Cells(3, "B"), Cells(3, "C"))

For i = 1 To NbMois
    m = DateSerial(Year(Cells(rw, "B")), Month(Cells(rw, "B")) + 1, Day(Cells(rw, "B")))
    Select Case Weekday(m)
        Case 1: dt = m - 2
        Case 2: dt = m - 3
        Case 3: dt = m + 3
        Case 4: dt = m + 2
        Case 5: dt = m + 1
        Case 6: dt = m + 0
        Case 7: dt = m - 1
        Case Else: dt = ""
    End Select

   Cells(rw, "C").Value = dt
   Cells(rw, "D").Value = jr(Weekday(dt))
   Cells(rw + 1, "B").Value = dt + 1

   rw = ActiveSheet.Cells(Rows.Count, "C").End(xlUp).Row + 1
Next i
End Sub

re,

voici une nouvelle version,

Bonjour,

je cible les vendredis de la dernière semaine de chaque mois entre deux dates.

Dit plus simplement, c'est le dernier vendredi du mois que tu veux ?

eric

Bonjour,

Sans VBA :

8ddetp.xlsx (17.25 Ko)

Bonjour Patrice,

C'est exactement ce que je veux mais je ne me vois pas traduire ta formule en VBA.

Est-ce que tu saurais le faire?

Merci pour ta proposition.

Cordialement

Bonjour Eric,

Dit plus simplement, c'est le dernier vendredi du mois que tu veux ?

Non ce n'est pas tout à fait ça.

Si en date de début de période j'écris le 01/02/2019 ca devient les premiers vendredis de chaque mois qui composent la période.

Si j'écris 04/02/2019 ça devient les premiers lundis qui composent la période et dernier exemple si j'écris 14/02/2019 ce sera les deuxième jeudis de chaque mois sur la période ciblée.

Cordialement

Patrice,

Si tu peux le traduire en vba, sache que seules les dates de la colonne C "Date mois suivant" m'intéressent.

La partie de mon projet intéressée par ce travail permet d'alimenter un agenda.

C'est à titre d'information.

Cordialement

Bonjour,

Je te transmets une fonction qui devrait répondre à ton problème.

Elle permet de retourner le dernier vendredi (ou autre jour) du mois et de l'année passés en paramètres.

Une autre fonction utilisée en interne par la précédente permet de connaître le nombre de jour d'un mois et d'une année précise (gère les années bissextiles).

Voici le code que tu retrouveras dans le fichier joint

Function DernierXduMoisSuivant(X As Byte, M As Byte, AN As Integer) As Date
    'X vaut 1 pouur dimanche
    'X vaut 2 pouur lundi
    'X vaut 3 pouur mardi
    'X vaut 4 pouur mercredi
    'X vaut 5 pouur jeudi
    'X vaut 6 pouur vendredi
    'X vaut 7 pouur samedi

    Dim NbjM As Byte
    Dim i As Integer
    Dim DateCourante As Date

    'Détermine le n° du mois suivant
    ' si 12 repasse à 1 et année est incrémentée de 1
    M = M + 1
    If M = 13 Then
        M = 1
        AN = AN + 1
    End If
    'Appel fonction NbJours_Mois()
    'qui renvoit le nom de jours d'un mois et d'une année précise
    'passés en paramètre
    NbjM = NbJours_Mois(M, AN)

    'Boucle qui tourne en négatif en partant
    'du dernier jour du mois
    'jusqu'à arriver à un vendredi (ou autre - voir valeurs ci-dessus)
    For i = NbjM To 1 Step -1
        DateCourante = CDate(i & "/" & M & "/" & AN)
        'si vendredi (ou autres) sortie de  boucle
        'et renvoi de la date correspondant
        ' au dernier vendredi du mois
        If Weekday(DateCourante) = X Then
            DernierXduMoisSuivant = DateCourante
            Exit For
        End If
    Next i
End Function

Private Function NbJours_Mois(Mois As Byte, ANNEE As Integer) As Byte
    If (ANNEE Mod 100 = 0 And Int(ANNEE / 100) Mod 4 = 0) Or (ANNEE Mod 4 = 0 And ANNEE Mod 100 <> 0) Then
        'année bissextile
        Select Case Mois
            Case 1, 3, 5, 7, 8, 10, 12
                NbJours_Mois = 31
            Case 2
                NbJours_Mois = 29
            Case 4, 6, 9, 11
                NbJours_Mois = 30
        End Select

    Else
        'année non bissextile
        Select Case Mois
            Case 1, 3, 5, 7, 8, 10, 12
                NbJours_Mois = 31
            Case 2
                NbJours_Mois = 28
            Case 4, 6, 9, 11
                NbJours_Mois = 30
        End Select

    End If
End Function

En espérant avoir répondu à tes attentes

Bien cordialement,

Bonjour GNIN,

Merci pour ta proposition. Je vais voir si je peux en tirer quelque chose.

Il faut que j’intègre un code VBA à l'userform de mon projet.

Pour l'heure je travaille sur le code de i20100 qui est le plus proche de mes attentes.

Ca ne fonctionne encore pas mais j'ai bon espoir

Cordialement

Rechercher des sujets similaires à "jour numero sem mois periode comprise entre dates"