VBA - Incrementation de date selon diverses conditions

Bonjour,

J'ai quelques notion de VBA. Je suis sur la création de ce code depuis plusieurs jours mais je n'arrive à rien...

Je vous explique... Je souhaite créer un fichier me permettant de planifier des interventions à une personne. Je souhaite qu'elle réalise n interventions par jour sur une semaine de 5 jours.

J'aimerai rentrer la date de début des interventions, le nombre d'intervention à faire ainsi que le nombre d'intervention par jour.
En sortie, j'aimerai avoir la liste des jours en fonction du nombre d'intervention par jours définis et sur 5 jours (évitons de travailler le week-end :)).

Je vous mets mon fichier que j'ai commencé ci-dessous. Les jours que je renseigne s'incrémente bien selon le nombre d'intervention par jours mais que pour la première partie...
Je pense que je n'en suis pas très loin mais je n'y arrive pas...

Pièce jointe 321272

Dans l'attente de vous lire,

Flomos

Bonjour
Je n'ouvre et n'ouvrirai jamais un classeur tiers et n'ai donc pas ouvert le tien.
Tu ne nous dis pas :
- dans quelles colonnes/ou lignes tu rentres :
- la date de début
- celle du nombre d'interventions par jour
etc ...
- qu'as-tu au moins tenté d'écrire ? (code tenté).
A ce stade :
Tu connais (par définition) le nombre d'interventions par jour
Tu connais le nombre de jours nécessaires pour faire toutes les interventions (simple division)
Il te reste à faire une simple boucle de pure arithmétique -->>
regarde ce que fait par exemple ceci sur ta colonne A formatée en date :
- mets une date valide en A1
- lance ce code tout bête

Code:

---

1 2 3 4 5

For k = 1 To 30 If Weekday(Range("A1").Value + k, vbMonday) < 6 Then Range("A" & k + 1).Value = Range("A1").Value + k End If Next

---

regarde, analyse, comprends et adapte.

EDIT :
1) il est bien clair que la date en A1 ne doit être ni un samedi, ni un dimanche (par définition)
2) si tu veux éviter les lignes blanches en colonne A, c'est également tout bête et également arithmétique, aini -->>

Code:

---

1 2 3 4 5 6 7 8

x = 0 For k = 1 To 30 If Weekday(Range("A1").Value + k, vbMonday) < 6 Then Range("A" & k + 1 - x).Value = Range("A1").Value + k Else x = x + 1 End If Next

---

Comme tu peux le constater, je ne fais là que faire appel à l'arithmétique et la logique. Le reste (application en code) n'étant que broutille "accessoire".

Bonjour,

J'ai seulement des notions en arithmétiques et en langages VBA. Le problème provient (encore une fois) de la machine qui tape sur les touches du clavier :P

J'ai construit mon tableau comme suit :

- Date de départ B1 :23/10/2017
- Nb de d'inter (N_inter) B2 : 60
-Nb d'inter par jours (I_jour) B3 : 5
- Nb de jours d'inter (J_inter) B4 : =B2/B3
-Les dates d'inter apparaissent dans la colonnes "D"

J'ai adapté légèrement le code que vous m'avez donné afin qu'il soit répété I_jour fois pour chaque date. Cependant, ce code remplace chaque valeur j-1 et s’arrête sur une erreur 1004 "la méthode Range de l'objet _Global à échoué".

For k = 0 To J_inter
For I = 1 To Range("B3")
If Weekday(Range("B1").Value + k, vbMonday) < 6 Then
Range("D" & k + I - y).Value = Range("B1").Value + k
Else
y = y + 1
End If
Next I
Next k

Merci pour l'aide apporté

je ne sais que te dire, sinon que:
1) l'erreur que tu as ne saurait être provoquée par le code que tu montres
2) les résultats de ton code ne sont pas ceux attendus (la logique en est d'ailleurs erronée)
3) l'adaptation directe de mon code à tes cellules donne les résultats attendus :

Code:

---

1 2 3 4 5 6 7 8

x = 0 For k = 0 To Range("B4").Value If Weekday(Range("B1").Value + k, vbMonday) < 6 Then Range("D" & k + 1 - x).Value = Range("B1").Value + k Else x = x + 1 End If Next

---

Etant bien entendu que :
- la cellule B1 et celles de la colonne D sont bien formatées en Date
- la cellule B1 contient une date valide et ne corresponde ni à un samedi, ni à un dimanche
- la cellule B4 est bien formatée en numérique et contient bien une valeur numérique

Je précise que je viens de prendre la peine de tester mon code sur ma machine --->> sans faille

Re-moi
J'ouvre toujours mieux les yeux de bon matin.
Mon code précédent n'est pas complet, dans la mesure où le nombre total d'interventions n'est pas atteint (du fait de l'incrémentation de k en dépit de non ouvré)
--->> légère modif pour corriger cet oubli --->>

Code:

---

1 2 3 4 5 6 7 8 9 10

x = 0 y = Range("B4").Value For k = 0 To y + y Mod 5 + 7 If Weekday(Range("B1").Value + k, vbMonday) < 6 Then Range("D" & k + 1 - x).Value = Range("B1").Value + k Else x = x + 1 End If If k + 1 - x >= Range("B4").Value Then Exit For Next

---

EDIT :
et si tu veux être plus complet, regarde ceci, qui indique en colonne E le nombre d'interventions prévu pour chacune des dates (y compris si le nombre total n'est pas un multiple du nombre quotidien)

Code:

---

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16

x = 0 y = Range("B4").Value For k = 0 To y + y Mod 5 + 7 If Weekday(Range("B1").Value + k, vbMonday) < 6 Then Range("D" & k + 1 - x).Value = Range("B1").Value + k Select Case (k + 1 - x) * Range("B3").Value Case Is <= Range("B2").Value Range("E" & k + 1 - x).Value = Range("B3").Value Case Else Range("E" & k + 1 - x).Value = Range("B2").Value Mod Range("B3").Value End Select Else x = x + 1 End If If k + 1 - x >= Range("B4").Value Then Exit For Next

---

Avec ce code vous dépassez largement mes connaissances en arithmétique et en logique. Il va falloir que je me renseigne pour le comprendre.

Je souhaite utilisé ces dates pour faire un publipostage. J'ai besoin qu'elles soient répétés le nombre d'inter prévu le jours.
exemple:
Date première inter : 23/10/2017 23/10/2017
Nb d'inter/j : 4 23/10/2017
23/10/2017
23/10/2017
24/10/2017
24/10/2017
24/10/2017
...

Avez vous une idée de comment faire cela ?

J'ai également remarqué que la macro s’arrête le vendredi 29 décembre 2017. Existe t-il une solution pour lui indiquer de continuer en 2018 ?

Citation:

---

J'ai également remarqué que la macro s’arrête le vendredi 29 décembre 2017. Existe t-il une solution pour lui indiquer de continuer en 2018 ?

---

Mais ... le millésime n'est aucunement considéré et la macro (mon code) passe bien à l'année suivante !
Quant au reste :
- on ne peut continuer ainsi à jouer au poker javanais
- arrête ta décision et montre ici une image (capture d'écran et non classeur) de ce que tu veux obtenir
Je verrai tout cela après ma partie de pêche.

Dans ces cas là, arrêtons de jouer

voici ce que j'aimerai obtenir de manière automatique :
Pièce jointe 321333

Ah ! C'est cela, que tu veux -->> Amen
Et je vais dans la foulée commencer à te faire aimer l'arithmétique. Je vais même m'amuser à l'aborder encore différemment.
Regarde --->>

Code:

---

1 2 3 4 5 6 7 8 9 10 11 12 13

x = 0 Columns("D").ClearContents For k = 0 To Range("B4").Value * 2 If Weekday(Range("B1").Value + k, vbMonday) < 6 Then derlig = IIf(Range("D1").Value = "", 1, Range("D" & Rows.Count).End(xlUp).Row + 1) reste = Range("B2").Value - (derlig - 1) If reste > Range("B3").Value Then reste = Range("B3").Value Range("D" & derlig & ":D" & derlig + reste - 1).Value = Range("B1").Value + k Else x = x + 1 End If If reste < Range("B3").Value Then Exit For Next

---

Il n'y a là-dedans rien qui relèverait de la sorcellerie. Juste un zeste de bon sens, une pincée de logique et une goutte d'arithmétique.

Il n'y a là-dedans rien qui relèverait de la sorcellerie. Juste un zeste de bon sens, une pincée de logique et une goutte d'arithmétique.[/QUOTE]

En effet, avec cette recette magi...arithmétique, c'est beaucoup plus simple et ça fonctionne ! Je vais gagner un temps fou avec ça !

Merci beaucoup pour ton aide.

Content pour toi.
Mais je sais que je te reverrai bientôt ici. Non en raison d'une erreur dans le code que je t'ai donné (il fait très exactement ce que tu avais défini), mais en raison d'un oubli de ta part.
J'attendrai donc une suite qui ne devrait pas rater... ;)
A bientôt.

Vous voyez un potentiel oubli de ma part ??

Il est vrais qu'un code ne planifiant pas les jours fériés serait exceptionnel mais il ne faut pas abuser des bonnes choses.

Citation:

---

ne planifiant pas les jours fériés

---

Tu vois, quand tu te réveilles, cela va toujours mieux.;)
Il va bien évidemment falloir prendre ceci en compte, hein. Sinon tout ton planning va prendre l'eau.
Commence par créer une liste de ces jours fériés non-ouvrés autres que de week-end. Cela t'évitera de tomber dans l'erreur de conception que je constate trop souvent : celle de les faire déterminer par programme, comme s'ils étaient forcément toujours les mêmes d'une année à l'autre, alors que tant leur nombre (11 en général) que leur choix peut varier et fait l'objet d'un décret pris chaque année. Des variantes peuvent en outre exister selon la nature de l'activité (je pense à certains commerces, dont les boulangeries, certains artisans, dont les coiffeurs, etc ...). Je pense également aux conséquences du choix fait d'un "jour de carence" par telle ou telle autre entreprise...
Le plus simple : utiliser tout bêtement la colonne A d'une feuille "non_ouvrés". Y mettre les dates concernées. Ne pas hésiter à y stocker également celles de l'année immédiatement antérieure. Et la compléter au besoin si des circonstances exceptionnelles conduisent à décréter en cours d'année un jour nouveau non prévu par le décret.
Reviens lorsque tu l'auras fait.

Eh me revoilà !

Pièce jointe 321600

Bonjour
Non. Va au plus simple --->> n'y mets que les dates (entières, millésime compris, genre 14/07/2017) en colonne A formatée en format date. A quoi te servirait le reste ? A rien, en fait, non ?
Puis le code, maintenant --->>
on ajoute juste une fonction --->>
Voilà ce qu'il devient, tout bêtement --->>
1) la fonction :

Code:

---

1 2 3 4

Private Function oualou(d As Date) As Boolean If Weekday(d, vbMonday) >= 6 Then oualou = True: Exit Function If Not Worksheets("non_ouvrés").Range("A:A").Find(d, LookIn:=xlValues) Is Nothing Then oualou = True End Function

---

2) ton code précédent :

Code:

---

1 2 3 4 5 6 7 8 9 10 11 12 13 14

Columns("D").ClearContents x = 0 For k = 0 To Range("B4").Value * 2 'If Weekday(Range("B1").Value + k, vbMonday) < 6 Then ' ---> ancienne ligne de code If Not oualou(Range("B1").Value + k) Then ' ---> maintenant remplacée par celle-ci derlig = IIf(Range("D1").Value = "", 1, Range("D" & Rows.Count).End(xlUp).Row + 1) reste = Range("B2").Value - (derlig - 1) If reste > Range("B3").Value Then reste = Range("B3").Value Range("D" & derlig & ":D" & derlig + reste - 1).Value = Range("B1").Value + k Else x = x + 1 End If If reste < Range("B3").Value Then Exit For Next

---

et le tour est joué. ;)

C'est parfait ! La macro va au delà de mes attentes initiales.

Un grand MERCI ! :ccool: