Gestion ETP Macro VBA

Le 17/12/2019 à 21:53

Bonjour

Je cherche à créer une macro afin d'obtenir un tableau d'équivalents temps plein (ETP) avec les personnes en ligne et les périodes (/mois en colonnes). Je voudrais obtenir un tableau de ce type par budget (Budget01 Budget02 etc)

Le tableau de saisie est joint (Feuil1 sur laquelle on saisit la répartition des ETP à partir d’une date donnée. Quand la répartition change, on créé une nouvelle ligne pour la personne avec une date de début) et celui que je voudrais obtenir est en Feuil2 (détail par budget, par personne et par mois). J’ai par ailleurs une Feuil3 comme référentiel de valeurs utilisées dans mon fichier.

J’ai une macro qui fonctionne tant bien que mal (Sub MizajourNN_ETP03()) mais je bute sur deux problèmes :

1 - Je ne trouve pas comment gérer une variable en fonction de mon écran de référence (Feuil3) pour les personnes par leurs initiales : recopier la partie dédiée à chaque personne (comme je l’ai fait dans ma macro) n’est en pratique pas possible mais je ne trouve pas comment faire autrement …

2 - J’ai une variable k (pour identifier la ligne où coller en Feuil2) que je suis contraint de gérer manuellement et je bute sur la façon de l’automatiser …

Le fichier joint est bien entendu un exemple (3 budgets, 3 personnes) car je voudrais gérer beaucoup plus de budgets et de personnes. Aussi j’ai tenté de 1 – créer une variable pour les initiales et 2 – de faire varier ma variable k en fonction des personnes mais je bute … sans trouver de solution.

Si une bonne âme parmi vous pouvait m’aider, cela serait super.

Merci par avance de vos conseils.

Ptiloup

153test-etp-v0-1.xlsm (30.89 Ko)
Le 18/12/2019 à 11:57

Bonjour,

une proposition

Sub aargh()
    Dim wss As Worksheet
    Dim wst As Worksheet
    Dim dcwst&, nombrebudgets&, ligne_budget&, ligne_wss, colonne_mois&, premiere_ligne_somme&, budget&
    Dim colonnedate$, initiales$, libelle_budget$, formulesomme$
    Dim datedeb As Date, datefin As Date

    Set wss = Sheets("feuil1")
    Set wst = Sheets("feuil2")
    dcwst = wst.Cells(4, Columns.Count).End(xlToLeft).Column
    wst.Range("A5").Resize(1000, dcwst).Clear
    wst.Range("A5").Resize(1000, dcwst).Interior.Color = 14348258
    wst.Range("C5").Resize(1000, dcwst - 2).NumberFormat = "0.00"

    colonnedate = "G" 'colonne depuis sur wss
    nombrebudgets = 4

    ligne_budget = 4
    premiere_ligne_somme = 5

    For budget = 1 To nombrebudgets
        libelle_budget = wss.Cells(4, budget + 1)
        ligne_budget = ligne_budget + 1
        ligne_wss = 5
        colonne_mois = 3

        Do While wss.Cells(ligne_wss, 1) <> ""
            datedeb = wss.Cells(ligne_wss, colonnedate)
            initiales = wss.Cells(ligne_wss, 1)
            If initiales = wss.Cells(ligne_wss + 1, 1) Then datefin = wss.Cells(ligne_wss + 1, colonnedate) Else datefin = DateValue("2100/01/01")
            wst.Cells(ligne_budget, 1) = libelle_budget
            wst.Cells(ligne_budget, 2) = initiales

            Do While wst.Cells(4, colonne_mois) < datedeb And colonne_mois <= dcwst 'recherche de la bonne colonne mois
                colonne_mois = colonne_mois + 1
            Loop

            Do While wst.Cells(4, colonne_mois) < datefin And colonne_mois <= dcwst 'remplissage du budget sur la période
                wst.Cells(ligne_budget, 1) = libelle_budget
                wst.Cells(ligne_budget, 2) = initiales
                wst.Cells(ligne_budget, colonne_mois) = wss.Cells(ligne_wss, budget + 1)
                colonne_mois = colonne_mois + 1
            Loop

            If initiales <> wss.Cells(ligne_wss + 1, 1) Then 'autres initiales
                ligne_budget = ligne_budget + 1
                colonne_mois = 3
            End If
            ligne_wss = ligne_wss + 1
        Loop

        ' mise en forme ligne total budget
        wst.Cells(ligne_budget, 1) = libelle_budget
        wst.Cells(ligne_budget, 2) = "Total"
        formulesomme = "=sum(R[-" & ligne_budget - premiere_ligne_somme & "]C:R[-1]C)"
        wst.Cells(ligne_budget, 3).Resize(1, dcwst - 2).FormulaR1C1 = formulesomme
        wst.Cells(ligne_budget, 1).Resize(1, dcwst).Interior.Color = xlNone
        premiere_ligne_somme = ligne_budget + 1

    Next budget

    wst.Range(ligne_budget + 1 & ":1010").Clear
End Sub
131test-etp-v0.xlsm (39.40 Ko)
Le 18/12/2019 à 12:25

Bonjour,

Une autre proposition.

Nécessite d'installer le complément Microsoft gratuit Power Query.

Un date de début, c'est bien, mais pas de date de fin ?

l'ETP est calculé au prorata des jours dans le mois...

Cdlt.

140test-etp-v0-1.xlsx (39.45 Ko)
Le 18/12/2019 à 13:36

Bonjour

Pour H2SO4

Wow ... impressionnant.

La macro fonctionne bien mais ne tient pas compte des changements d'ETP en fonction de la date de début ; en me relisant, je réalise que ma demande n'était probablement pas assez précise (sorry).

Exemple : (cf fichier joint mis à jour) : pour la personne AA, son Nb d'ETP pour le Budget01 est de 0.1 à partir du 1/12/2017 et change à 0.11 à partir du 5/4/2018, puis passe à 0.12 à partir du 3/8/2018. Il n'y a pas de date de fin car, par défaut, on garde chaque mois la même allocation depuis la dernière date du changement

PourJean-Eric

  • Merci car je n'avais pas pensé au TCD
  • Mais je ne suis pas très à l'aise avec les TCD pour ce type de données qui sont évolutives et les extractions de TCD me sont obscures ...
  • Pas de date de fin effectivement car on ne gère qu'une date de début ... jusqu'au changement qui est une date de début mais aussi une date de fin pour la précédente période
  • ETP pro-ratisé : c'est très juste mais en pratique, pour notre utilisation, on modifie les allocations en comptant systématiquement à partir du 1er (pas d'utilisation par les RH et notamment pas d'impact budgétaire ou de salaire)
131test-etp-v0-2.xlsm (37.25 Ko)

Merci de votre aide.

Ptiloup

Le 18/12/2019 à 13:44

Bonjour,

Le TCD c'est le résultat.

Comme écrit précédemment, j'ai utilisé Power Query.

Pour poursuivre, il faut savoir si tu as la possibilité d'installer ce complément (32 ou 64bit !).

Sinon, pour résumer, pas de date de fin, donc la fin est la date du jour -1. Tes données devaient s'étendre jusqu'au 17 déc. 2019 ?

Cdlt.

Le 18/12/2019 à 14:47

bonjour,

code adapté

Option Explicit
Sub aargh()
    Dim wss As Worksheet
    Dim wst As Worksheet
    Dim dcwst&, nombrebudgets&, ligne_budget&, ligne_wss, colonne_mois&, premiere_ligne_somme&, budget&
    Dim colonnedate$, initiales$, libelle_budget$, formulesomme$
    Dim datedeb As Date, datefin As Date

    Set wss = Sheets("feuil1")
    Set wst = Sheets("feuil2")
    dcwst = wst.Cells(4, Columns.Count).End(xlToLeft).Column
    wst.Range("A5").Resize(1000, dcwst).Clear
    wst.Range("A5").Resize(1000, dcwst).Interior.Color = 14348258
    wst.Range("C5").Resize(1000, dcwst - 2).NumberFormat = "0.00"

    colonnedate = "G" 'colonne depuis sur wss
    nombrebudgets = 4

    ligne_budget = 4
    premiere_ligne_somme = 5

    For budget = 1 To nombrebudgets
        libelle_budget = wss.Cells(4, budget + 1)
        ligne_budget = ligne_budget + 1
        ligne_wss = 5
        colonne_mois = 3

        Do While wss.Cells(ligne_wss, 1) <> ""
            datedeb = wss.Cells(ligne_wss, colonnedate)
            datedeb = DateSerial(Year(datedeb), Month(datedeb), 1) 'date debut au premier du mois
            initiales = wss.Cells(ligne_wss, 1)
            If initiales = wss.Cells(ligne_wss + 1, 1) Then datefin = wss.Cells(ligne_wss + 1, colonnedate) Else datefin = DateValue("2100/01/01")
            datefin = Application.WorksheetFunction.EoMonth(datefin, -1) 'date fin au dernier jour du mois précédent
            wst.Cells(ligne_budget, 1) = libelle_budget
            wst.Cells(ligne_budget, 2) = initiales

            Do While wst.Cells(4, colonne_mois) < datedeb And colonne_mois <= dcwst 'recherche de la bonne colonne mois
                colonne_mois = colonne_mois + 1
            Loop

            Do While wst.Cells(4, colonne_mois) < datefin And colonne_mois <= dcwst 'remplissage du budget sur la période datedeb à datefin
                wst.Cells(ligne_budget, 1) = libelle_budget
                wst.Cells(ligne_budget, 2) = initiales
                wst.Cells(ligne_budget, colonne_mois) = wss.Cells(ligne_wss, budget + 1)
                colonne_mois = colonne_mois + 1
            Loop

            If initiales <> wss.Cells(ligne_wss + 1, 1) Then 'autres initiales
                ligne_budget = ligne_budget + 1
                colonne_mois = 3
            End If
            ligne_wss = ligne_wss + 1
        Loop

        ' mise en forme ligne total budget
        wst.Cells(ligne_budget, 1) = libelle_budget
        wst.Cells(ligne_budget, 2) = "Total"
        formulesomme = "=sum(R[-" & ligne_budget - premiere_ligne_somme & "]C:R[-1]C)"
        wst.Cells(ligne_budget, 3).Resize(1, dcwst - 2).FormulaR1C1 = formulesomme
        wst.Cells(ligne_budget, 1).Resize(1, dcwst).Interior.Color = xlNone
        premiere_ligne_somme = ligne_budget + 1

    Next budget

    wst.Range(ligne_budget + 1 & ":1010").Clear
End Sub
139test-etp-v0.xlsm (39.72 Ko)
Le 18/12/2019 à 19:16

Bonjour

C'est bien ce que je craignais ... Il y en a qui ont la classe et il y a les autres ...

Mille merci à J-Eric : je ne connaissais pas Power Query (téléchargé en 32bits) et il faut que j'investigue les possibilités qui ont l'air d'être nombreuses.

Mille merci également à H2SO4 (chimiste de formation j'imagine !) pour cette macro qui fonctionne parfaitement. Sauf avis contraire, je préciserai les références H2SO4 comme source pour cette macro.

Voilà une très belle journée grâce à vous deux (non je n'avouerai pas combien de temps j'ai passé sur cette macro avant de poser la question sur le forum ...)

Très bonne soirée.

Cordialement.

Ptiloup

Le 18/12/2019 à 19:35

Re,

Merci de ce retour.

Et bonne continuation avec Power Query !...

Cdlt.

Rechercher des sujets similaires à "gestion etp macro vba"