Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

Microsoft 365 Lissage du budget sur nombre de jours du mois

aba2s

XLDnaute Junior
Bonjour la communauté,

Je galère sur une tâche sur Excel/VBA sans succès. Je souhaite lisser le budget sur le nombre de jours du mois sur le nombre total de jours. Je souhaite avoir le même résultat que celui qui se trouve à la ligne 4 de la colonne AC à la colonne AN.

Exemple : Start Date = 24/04/2020
End Date = 31/10/2020
Total Budget = 245.00 €

On devrait avoir sur :

- avril : 245 * 7/ (End Date - Start Date +1)
- mai : 245*31/ (End Date - Start Date +1)
- Juin : 245*30/(End Date - Start Date +1)
- Juillet : 245*31/(End Date - Start Date +1)
- Août : 245*31/(End Date - Start Date +1)
- Sept : 245*30/(End Date - Start Date +1)
- Oct : 245*31/(End Date - Start Date +1)

Merci beaucoup pour votre
Code:
Public Function DailyBudgetForecast(L As Integer, C As Integer)


    'Dim i As Byte
    'Dim FeDataPipe As Worksheet: Set eDataPipe = ThisWorkbook.Worksheets("Data - Pipe")
    Dim month1, month2 As Integer
    Application.Volatile
    
    sDate = Cells(L, 23)
    eeDate = Cells(L, 24)
    
    month1 = Month(Cells(L, 23))                 ' Start month extract
    month2 = Month(Cells(L, 24))                 ' End month extract

    If (C - 28) >= month1 And (C - 28) <= month2 Then ' Month segment definition
        
        repart = Day(DateSerial(Year(sDate), Month(sDate) + 1, 0)) - Month(sDate)
        DailyBudgetForecast = repart * Round(Cells(L, 22) / (eeDate - sDate + 1), 2) ' Average value distribution
    Else
        DailyBudgetForecast = ""
    End If
    If DailyBudgetForecast = "" Then DailyBudgetForecast = ""
    
End Function
aide
 

job75

XLDnaute Barbatruc
Bonjour aba2s,

Dans le code remplacez :
VB:
Repart = Evaluate("EXP(LN(MIN(" & dat2 & ",EOMONTH(""" & col & "/1"",0))-MAX(" & dat1 & ",""" & col & "/1"")+1))*" & Total & "/(" & dat2 - dat1 & "+1)")
par :
Code:
Repart = Evaluate("(MIN(" & dat2 & ",EOMONTH(""" & col & "/1"",0))-MAX(" & dat1 & ",""" & col & "/1"")+1)*" & Total & "/(" & dat2 - dat1 & "+1)")
Vous comprendrez que EXP(LN(xxx)) permet d'éliminer les valeurs négatives (ou nulles).

A+
 

Dranreb

XLDnaute Barbatruc
Bonjour.
1/(1/xxx) devrait être tout aussi efficace.
ou presque …
Il devrait y avoir aussi du Sqr(xxx)^2 dedans. Où faire un truc plus clair que ce genre de choses …
 
Dernière édition:

job75

XLDnaute Barbatruc
Re, salut Bernard,

En fait on peut supprimer EXP(LN et éliminer les valeurs négatives comme ceci :
VB:
Function Repart(Total As Double, dat1 As Long, dat2 As Long, col As Byte)
Repart = Evaluate("(MIN(" & dat2 & ",EOMONTH(""" & col & "/1"",0))-MAX(" & dat1 & ",""" & col & "/1"")+1)*" & Total & "/(" & dat2 - dat1 & "+1)")
If Repart <= 0 Then Repart = ""
End Function
A+
 

job75

XLDnaute Barbatruc
Cela dit pour les mois en ligne 1 il vaut mieux des dates au lieu des textes avec ce code du fichier (2) :
VB:
Function Repart(Total#, dat1&, dat2&, datmois&)
Repart = Evaluate("(MIN(" & dat2 & ",EOMONTH(" & datmois & ",0))-MAX(" & dat1 & "," & datmois & ")+1)*" & Total & "/(" & dat2 - dat1 & "+1)")
If Repart <= 0 Then Repart = ""
End Function
 

Pièces jointes

  • VBA(2).xlsm
    17.5 KB · Affichages: 9

aba2s

XLDnaute Junior
Merci beaucoup @job75
J'ai un dernier point promis
Nous nous approchons de la fin d'année et j'ai inseré des colonnes 2021(Jan, Fev, Mars, Avril).
Quand je tire la formule, la macro ne prend pas en compte ces nouvelles colonnes 2021.

Je ne vois pas ou modifier?

Merci beaucoup d'avance pour ton aide.
 

job75

XLDnaute Barbatruc
Bonjour aba2s,
Nous nous approchons de la fin d'année et j'ai inseré des colonnes 2021(Jan, Fev, Mars, Avril).
Quand je tire la formule, la macro ne prend pas en compte ces nouvelles colonnes 2021.
Bien sûr que si, à condition d'utiliser le fichier (2) du post #21.

C'est justement pour ça que je vous ai dit de mettre des dates en ligne 1.

A+
 

Pièces jointes

  • VBA(2 bis).xlsm
    17.7 KB · Affichages: 8

Discussions similaires

Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…