Déterminer 1er lundi du mois en semaine paire etc...

Question

Bonjour, 

Je vais essayer de vous expliquer rapidement mon souci.
J'ai un fichier Planning qui contient un onglet par semaine. Sur chaque onglet j'ai donc 6 dates correspondant aux jours de la semaine en question (l'onglet 1 correspond à la semaine 1 de l'année en cours, j'ai donc lundi 29/12/2014, mardi 30/12/2014 etc jusqu'au samedi 3/01/2015)
J'ai un autre fichier Clients, qui liste tous nos clients ainsi que la fréquence à laquelle on doit intervenir chez eux (tous les lundis, tous les lundis des semaines paires (ou impaires), le 1er lundi du mois (ou le 2ème, le dernier....), le 1er lundi du mois en semaine paire (ou impaire), le 1er lundi uniquement sur le mois pairs... etc etc bref toutes les fréquences possibles et bien-sûr pas que les lundis, ça marche aussi pour les autres jours de la semaine.


Je voudrais donc que pour chaque date de mon onglet actif du classeur Planning, vérifier si un client correspond à ce/ces critères. Et si c'est le cas, mettre le nom du client dans une cellule à côté de la date en question.

Par exemple, pour le lundi 5 janvier 2015, il faut extraire les clients qui ont une fréquence d'intervention du lundi de toutes les semaines, mais aussi du 1er lundi du mois, des lundis en semaine paire, du 1er lundi en semaine paire, du 1er lundi en mois impair.

J'ai fait quelques recherches mais j'ai beaucoup de mal à manipuler les dates et je voudrais comprendre comment vérifier tous les critères possibles:

Est-ce que c'est le:
1er lundi du mois?
2ème lundi du mois?
le dernier lundi?
le 1er lundi en semaine paire?

Et autre question, comment je peux écrire clairement la fréquence d'intervention pour que la macro puisse la comparer avec la date à tester? Pour le moment, j'ai fait une colonne "jour", une autre "récurrence" (toutes les semaines, une fois par mois..), une "semaine" (paire ou impaire), une "mois" (pair ou impair) et enfin une "fréquence" (le 1er, le 2ème, le dernier..)

Merci de m'apporter quelques réponses/ bouts de piste. J'avance lentement mais je préfère vraiment comprendre ce que je fait plutôt que d'écrire bêtement les solutions qu'on me donne! :-)

Si besoin je mettrais mes fichiers et mon code mais je vais devoir les épurer grandement! :-)

Bonne journée à tous!


Configuration: Windows 7 / Firefox 34.0

pijaku · Answer

Bonjour,

Mon premier conseil, en ce qui concerne les dates sous VBA, est d'utiliser un max de petites fonctions. En effet, avec les dates on réalise bien souvent le même type d'opération.

Mon second conseil est de s'accrocher parce que... ça "saoule" vite. 

Voici déjà quelques fonctions :

Option Explicit
'variables 
Dim Annee As Integer
Dim Mois As Integer
Dim Jour As Integer

'la sub principale :
Sub test()
MsgBox Combientieme("MERCREDI", CDate("12/02/2014"))
End Sub

'Les fonctions :

Function Combientieme(Jourdelasemaine As String, maDate As Date) As Integer
Dim i, Dates As Object, Cpt As Integer

Mois = Month(maDate)
Annee = Year(maDate)
Set Dates = CreateObject("Scripting.Dictionary")
For i = 1 To DernierJour(Mois, Annee)
    If UCase(Format(i & "/" & Mois & "/" & Annee, "dddd")) = UCase(Jourdelasemaine) Then
        Cpt = Cpt + 1
        Dates(CDate(i & "/" & Mois & "/" & Annee)) = Cpt
    End If
Next i
Combientieme = Dates(maDate)
End Function

Function DernierJour(Mois As Integer, Annee As Integer) As Integer
Select Case Mois
    Case 1, 3, 5, 7, 8, 10, 12
        DernierJour = 31
    Case 4, 6, 9, 11
        DernierJour = 30
    Case 2
        DernierJour = IIf(EstBissextile(Annee), 29, 28)
    Case Else
        DernierJour = 0 'cas d'une erreur
End Select
End Function

Function EstBissextile(Annee As Integer) As Boolean
EstBissextile = False
If Annee Mod 4 = 0 And (Annee Mod 100 <> 0 Or Annee Mod 400 = 0) Then EstBissextile = True
End Function


 
&#127932; Cordialement,
Franck &#127926;

Utilisateur anonyme · Answer

Bonjour.

Voici des éléments, pour savoir à quel jour correspond une date, il faut utiliser Weekday().

Si tu cherches le premier lundi du moi, et bien par du premier jour, regarde si c'est un lundi si oui super, sinon ajoute un jour etc...

Pour savoir à quel numéro de semaine correspond une date regade ici https://www.mrexcel.com/board/threads/date-to-week-number-using-vba.218978/#post1069391

Pour ta récurrence, ça me parrait trés compliqué de mettre tous les paramètres dans une seule colonne, déjà ton départ est un jour ou un numéro (le mardi ou le 10), ensuite tu peux avoir une récurence mensuelle, hebdomadaire ou journalière.
Tu pourrais faire un UserForm avec des boutons à cocher et des listes déroulantes qui proposent toutes les conditions possibles.
Tu peux t"inspirer des récurrences des différents logiciels de rendez-vous (outlook, etc..)

jordane45 · Answer

Bonjour,
Pour chercher le Nieme jour d'un mois.. tu peux utiliser ceci :

Function niemejourMois(num_jour As Integer, position_jour As Integer, mois As Integer, annee As Integer) As Date
Dim firstDayOfMonth As Integer
Dim DatefirstDayOfMonth As Date
    DatefirstDayOfMonth = CDate(Format(CDate("01/" & mois & "/" & annee), "dd/mm/YYYY"))
    firstDayOfMonth = Day(DatefirstDayOfMonth)

If num_jour = firstDayOfMonth And position_jour = 1 Then
    niemejourMois = firstDayOfMonth
Else
    If num_jour = firstDayOfMonth Then
        niemejourMois = DatefirstDayOfMonth + ((position_jour - 1) * 7)
    Else
        niemejourMois = DatefirstDayOfMonth + ((position_jour - 1) * 7) - firstDayOfMonth + num_jour
    End If
End If

End Function


Et pour tester :

Sub test()
' Date du Quatrième Mercredi du mois de décembre 2014 :
msgbox niemejourMois(3, 4, 12, 2014)
End Sub

jordane45 · Answer

Aller.. une petite dernière...

Pour trouver (comme la précédente) le Nième jour (de la semaine) d'un mois donné..avec possibilité de ne prendre que les semaines PAIR / IMPAIR ou ALL (peu importe)

Function listJoursduMois(num_jour As Integer, mois As Integer, annee As Integer, Optional filtreSemainePairImpair = "ALL") As Variant()
 Dim dateTmp As Date
 Dim L As Integer
 Dim numSemaine As Integer
 Dim arrListDateJofMonth()
 Dim firstDayOfMonth As Integer
 Dim DatefirstDayOfMonth As Date
 Dim DateLastDayOfMonth As Date
   DatefirstDayOfMonth = CDate(Format(CDate("01/" & mois & "/" & annee), "dd/mm/YYYY"))
   DateLastDayOfMonth = DateAdd("d", -1, DateAdd("m", 1, DatefirstDayOfMonth))
   firstDayOfMonth = Day(DatefirstDayOfMonth)
   L = 0
   dateTmp = DatefirstDayOfMonth
  
  Do
   'Debug.Print ("dateTmp : " & dateTmp & "  -- weekday(dateTmp): " & Weekday(dateTmp))
   If Weekday(dateTmp) - 1 = num_jour Then
       numSemaine = WeekNum(dateTmp)
       semainePair = (numSemaine Mod 2 = 0)
    Select Case filtreSemainePairImpair
        Case "ALL"
            L = L + 1
            ReDim Preserve arrListDateJofMonth(3, L)
            arrListDateJofMonth(0, L - 1) = dateTmp
            arrListDateJofMonth(1, L - 1) = numSemaine
            arrListDateJofMonth(2, L - 1) = semainePair

Case "PAIR"
            
            If semainePair = True Then
                L = L + 1
                ReDim Preserve arrListDateJofMonth(3, L)
                arrListDateJofMonth(0, L - 1) = dateTmp
                arrListDateJofMonth(1, L - 1) = numSemaine
                arrListDateJofMonth(2, L - 1) = semainePair
            End If
        
        Case "IMPAIR"
             
            If semainePair = False Then
                L = L + 1
                ReDim Preserve arrListDateJofMonth(3, L)
                arrListDateJofMonth(0, L - 1) = dateTmp
                arrListDateJofMonth(1, L - 1) = numSemaine
                arrListDateJofMonth(2, L - 1) = semainePair
            End If
    End Select

End If
   dateTmp = DateAdd("d", 1, dateTmp)
  Loop Until dateTmp >= DateLastDayOfMonth
    
 listJoursduMois = arrListDateJofMonth
  
End Function

Function WeekNum(D As Date) As Integer
     WeekNum = CInt(Format(D, "ww", 2))
End Function
 
 
Et pour tester :

Sub test2()
'Par exemple... Connaitre la date
' du  troisième mercredi du mois de novembre 2014
arrListJour = listJoursduMois(3, 11, 2014)
MsgBox arrListJour(0, 3 - 1)

'Par exemple... Connaitre la date
' du  jeudi du mois de novembre 2014 de la deuxieme semaine PAIR
arrListJour = listJoursduMois(4, 11, 2014, "PAIR")
 MsgBox arrListJour(0, 2 - 1)

'Par exemple... Connaitre la date
' du  jeudi du mois de novembre 2014 de la première semaine PAIR
arrListJour = listJoursduMois(4, 11, 2014, "PAIR")
 MsgBox arrListJour(0, 1 - 1)
End Sub


Il y a surement des ajustements à faire.. mais ça donne un bon début..

SF-TU · Answer

Merci beaucoup pour toutes vos réponses, je vais essayer de décortiquer tout ça mais je pense que je reviendrais très vite demander des précisions! :-)

Déterminer 1er lundi du mois en semaine paire etc...

5 réponses

Discussions similaires

Newsletters