Lissage de charges de travail sur 2024
Bonjour à tous,
Je n'arrive plus à avancer sur ce fichier donc je viens vers vous pour savoir si quelqu'un pourrai m'aider. J'ai ce fichier sur lequel je veux lisser plusieurs opération différentes sur 52 semaines en fonction de la date de lancement initial (AD7). J'ai un cycle (récurrence) et une charge (durée) qui me donneront automatiquement ma date de lancement en respectant ma charge de travail maximum par semaine (AD6). En fonction de si les équipe commence mardi, il y a aussi une fonction de décalage de la date (AD5). J'ai aussi une feuille SemainesurAnnée qui me triera toutes les dates sorties par n° de semaine
Mon problème est que je n'arrive pas à afficher les dates jusqu'à la 52ème semaine et il y a des dates d'années supérieur à 2024 qui se mettent au milieu des autres dates. Sur le calcul de charge aussi, j'ai des semaines ou je vais avoir du travail comme demandé mais la semaine d'après je me retrouve avec pas du tout assez de travail. En ayant essayer plein d'autres choses (reprendre la somme des charges par semaine et quand dépassé je bascule sur la semaine d'après ainsi de suite) et je ne parvient pas à régler ces problèmes. Dans l'idéal, je souhaiterai arriver à faire partir la date de lancement 1 jour après en divisant la charge max par le nombre de jour travaillé (si 35h alors 5j à 7h).
Merci pour votre aide.
Bonsoir,
Concernant ceci:
Mon problème est que je n'arrive pas à afficher les dates jusqu'à la 52ème semaine
dans votre code, remplacez 75 par 82 (à 2 emplacements)
Je n'ai pas regardé le reste.
Cdlt
Bonsoir,
merci pour votre réponse, justement j'ai déjà essayé et cela me fausse complètement les dates et je ne sais pas pourquoi.
Bonne soirée
Bonjour,
Essayez ceci (les modifications apportées sont repérées par des ****************************:)
Sub RemplirDates()
' Supprimer les données existantes
Range("AE9:CE1600").ClearContents
' Variables
Dim DateLancement As Date
Dim Ecart As Integer
Dim ChargeHeure As Double
Dim ChargeTotale As Double
Dim NouvelleDate As Date
Dim Semaine As Integer
Dim i As Integer, j As Integer, k As Integer
Dim ChargeMaxi As Double
Dim Decalage As Integer
Dim Der_Sem As Long
Application.ScreenUpdating = False
' Date initiale
DateLancement = Sheets("Lissage gammes").Range("AD7").Value
' Charge maximale personnalisée
ChargeMaxi = Sheets("Lissage gammes").Range("AD6").Value
' Décalage
Decalage = Sheets("Lissage gammes").Range("AD5").Value
DateLancement = DateLancement + Decalage ' Appliquer le décalage
ChargeTotale = 0 ' Initialisation de la charge totale
' Boucle sur les lignes de lancement
For k = 9 To 1050 ' Changez cette plage en fonction de vos besoins
Der_Sem = 1 'on affecte la valeur 1 à la variable de Der_Sem **************************************************
' Valeurs initiales
ChargeHeure = Cells(k, "AC").Value ' Charge en heure
Ecart = Cells(k, "AB").Value ' Ecart
If IsNumeric(ChargeHeure) Then ' Vérification si la charge est bien un nombre
ChargeTotale = ChargeTotale + ChargeHeure ' Cumul de la charge de travail
' Si la charge totale dépasse la charge maximale, passer à la semaine suivante et réinitialiser le cumul de la charge de travail
If ChargeTotale > ChargeMaxi Then
ChargeTotale = ChargeHeure ' Réinitialiser le cumul de la charge de travail
DateLancement = DateLancement + 7 ' Passer à la semaine suivante
End If
' Remplir la colonne "AD" avec la date de lancement
Cells(k, "AD").Value = DateLancement
' Remplir les dates
For i = 0 To 52 ' Aller jusqu'à 52 semaines
' Calculer la nouvelle date
NouvelleDate = DateLancement + (i * Ecart)
' Trouver le numéro de semaine
Semaine = Application.WorksheetFunction.WeekNum(NouvelleDate, 21)
'*******************************************************************************************************
If Semaine < Der_Sem Then GoTo Ligne_Suivante
Der_Sem = Semaine 'on affecte le N° de la semaine testée à la variable Der_Sem
'*******************************************************************************************************
' Trouver la colonne correspondante
Dim Colonne As Integer
Colonne = 30 ' Colonne AD = 30
While Cells(8, Colonne).Value <> Semaine And Colonne <= 82 ' 56 pour CB
Colonne = Colonne + 1
Wend
If Colonne > 82 Then Exit For ' Sortir de la boucle si la semaine n'est pas trouvée
' Remplir la date sous le bon numéro de semaine
j = k ' Commencer à partir de la même ligne
While Cells(j, Colonne).Value <> "" And j <= 1050
j = j + 1
Wend
If j > 1050 Then Exit For ' Sortir de la boucle si pas de place
Cells(j, Colonne).Value = NouvelleDate
Next i
End If
Ligne_Suivante: '***************************************************************************
Next k
End SubCdlt
Bonjour,
Merci pour votre aide, le code marche bien et permet effectivement d'atteindre la 52ème semaine en respectant les cycles.
Le problème est maintenant de respecter la charge attribué par semaine. J'essaie différentes choses mais si vous avez des idées, n'hésitez pas :)
Encore merci, bon dimanche !
Le problème est maintenant de respecter la charge attribué par semaine. J'essaie différentes choses mais si vous avez des idées, n'hésitez pas :)
Là, je n'ai compris ce que vous attendez donc, partant de là difficile d'essayer de trouver une solution.
Expliquez précisément ce qu'il faut faire, le mieux est de mettre un bout de fichier avec quelques exemples de résultats attendus.
Cdlt
Le but est de respecter une charge de travail assigné en AD6, qui est la charge max de travail a donner, il faut savoir que dans la feuille semaine sur année j'extraie par vba toutes les dates des opérations par semaines (Semain 1à52) et je trie par N°Semaine afin de savoir ce que j'ai à faire tel ou tel semaine. Devant chaque opération j'ai sa durée. Le code (aussi pj 1er message) m'a l'air de fonctionner mais au fur et à mesure des semaines on arrive à des semaines à 200h et quelques.
Donc le résultat attendu et d'avoir en moyenne la charge défini par semaine (soit 35h/40h / Semaine) sur chaque semaine de l'année.