Calcul répété avec utilisation de Date

Version imprimable

12/01/2014, 20h26
toniob44

Calcul répété avec utilisation de Date

Bonjour,

Je vous explique mon problème.
J'ai sur une feuille des données composées de 3 colonnes avec 12 lignes
Voir mon fichier joint: http://cjoint.com/data/0AmuxscDVMp.htm

Dans cet exemple on imagine que le total des coefficients fait 1.

J'ai maintenant 2 variables au format Date: DateM (01/01/2013) et DateV(01/05/2013)

j'aimerai calculer la différence entre les 2 dates(encore cela ca va) et additionner les coefficients qui se trouvent entre DateM et date V en prenant en compte mois par mois.
on aura:
Total = coefJanvier + coefFévrier+ coefMars + CoefAvril + CoefMai ( en prennant en compte que dateV n'est que au début du mois)

J'ai d'abord commencé par utilisé For Each Cell in Range A1:A12
Mais je suis totalement perdu. Je pense que je suis partit trop loin que sa être hyper simple

Es ce que quelqu'un a une idée. Toujours en utilisant une macro ??

Merci à vous et bonne soirée.

Une solution parmi d'autres

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
Option Explicit
Sub TestCalculTotal()
  MsgBox CalculTotal(Range(Cells(2, 3), Cells(13, 3)), Cells(20, 3), Cells(21, 3))
End Sub
Function CalculTotal(Pl As Range, Date1 As Date, Date2 As Date)
Dim Cell As Range
Dim RowNo As Long
Dim Mois As Integer, Mois1 As Integer, Mois2 As Integer
  Mois1 = Format(Date1, "m")
  Mois2 = Format(Date2, "m")
  CalculTotal = 0
  For Each Cell In Pl
    RowNo = Cell.Row
    Mois = Cells(RowNo, 1)
    If Mois >= Mois1 And Mois <= Mois2 Then
      CalculTotal = CalculTotal + Cells(RowNo, Pl.Column)
    End If
  Next
End Function

13/01/2014, 22h30
toniob44

Bonjour defluc,

Merci pour ta réponse ta fait en 20 lignes ce que j'ai fait en 50 lignes ;)

J'ai deux questions:
-Penses tu pouvoir prendre en compte si DateM=01/01/2013 et DateV=01/05/2015 ? soit 2 ans et 4 mois de différence ?
-Penses tu que l'on pourra prendre en compte un ratio de DateM/Nbrdejourdanslemois(Mois(DateM)) et DateV/Nbrdejourdanslemois(Mois(DateV)) pour avoir un ratio du coefficient si par exemple DateV=01/05/2015 cela va prendre le coef du mois de mai à 100%

Je t'ai fait quelques exemples pour bien comprendre mes explications ;)
J'y ai ajouté ton beau petit code :)

http://cjoint.com/data/0Anww5Ehz84.htm

Merci beaucoup pour ton aide.
13/01/2014, 23h26
defluc

Hello toniob44,

Citation:

-Penses tu pouvoir prendre en compte si DateM=01/01/2013 et DateV=01/05/2015 ? soit 2 ans et 4 mois de différence ?
-Penses tu que l'on pourra prendre en compte un ratio de DateM/Nbrdejourdanslemois(Mois(DateM)) et DateV/Nbrdejourdanslemois(Mois(DateV)) pour avoir un ratio du coefficient si par exemple DateV=01/05/2015 cela va prendre le coef du mois de mai à 100%

Mon maitre mot : en programmation, TOUT est possible.

Et ce principe posé, quel bonheur de creuser pour trouver une solution, l'améliorer, la peaufiner.
Mais il faut préserver ses neurones et je vais donc dormir en te laissant sur tes rêves.

Dodoooo et à +
14/01/2014, 04h23
Philippe Tulliez

Bonjour,

Citation:

Mon maitre mot : en programmation, TOUT est possible.

:ccool:
C'est ce que je répète depuis plus de 25 ans.
Quand on me pose la question Est-possible ?, je répond "On peut tout faire en programmation, même allumer votre machine à café. C'est une question de temps et d'argent"

Merci pour vos réponses ;)

alors j'ai fait évoluer la macro, pas de beaucoup pour vous mais moi c'est énorme: http://cjoint.com/data/0Aokm1iaKxF.htm

J'arrive à définir le ratioM et RatioV pour éviter de prendre le Coef du mois en entier pour avoir un calcultotal plus précis.

Egalement je peux boucler sur chaque année.
Seulement il manque le total des coeffs 06 à 12. Si DateM=01/01/2013 et DateV=01/05/2015.

Avez-vous une idée pour régler ce problème ?
Le ratioV ne fonctionne pas n'ont plus mais je pense le calculer à la fin et le déduire de Calcultotal. Sa fera pareil.

Voici le code:
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 Option Explicit Sub TestCalculTotal() MsgBox CalculTotal(Range(Cells(2, 3), Cells(13, 3)), Cells(20, 3), Cells(21, 3)) End Sub Function CalculTotal(Pl As Range, DateM As Date, DateV As Date) As Currency Dim Cell As Range Dim RowNo As Long Dim Mois As Integer, MoisM As Integer, MoisV As Integer Dim RatioM, RatioV As Currency Dim Annee As Integer MoisM = Format(DateM, "m") MoisV = Format(DateV, "m") RatioM = (DaysInMonth(Month(DateM), Year(DateM)) - Day(DateM)) / DaysInMonth(Month(DateM), Year(DateM)) RatioV = (Day(DateV)) / DaysInMonth(Month(DateV), Year(DateV)) CalculTotal = 0 For Annee = Year(DateM) To Year(DateV) For Each Cell In Pl RowNo = Cell.Row Mois = Cells(RowNo, 1) If Mois >= MoisM And Mois <= MoisV Then CalculTotal = CalculTotal + Cells(RowNo, Pl.Column) * RatioV * RatioM RatioM = 1 RatioV = 1 End If Next Next Annee End Function Public Function DaysInMonth(ByVal nMonth As Integer, ByVal nYear As Integer) As Integer DaysInMonth = Day(DateAdd("d", -1, DateAdd("m", 1, DateSerial(nYear, nMonth, 1)))) End Function
Merci à vous Dieus de la programmation.
Philippe Tulliez, si tu peux me faire démarrer ma cafetière tous les matins avec une macro je suis preneur :lol:

Ce qui suit devrait t'avancer (Anachronisme) :D
Code:

1 2 3 If DateDiff("m", DateM, DateV) = 28 Then ' 28 pour 2 ans et 4 mois End If

14/01/2014, 12h30
toniob44

Désolé, mais je n'ai pas saisi le but de ce code ?
A quoi peut-il me servir ?

Merci Defluc en tout cas.
14/01/2014, 12h48
defluc

Ben ça répond à ta question

Citation:

-Penses tu pouvoir prendre en compte si DateM=01/01/2013 et DateV=01/05/2015 ? soit 2 ans et 4 mois de différence ?
14/01/2014, 16h02
toniob44

Pardon j'ai du mal m'exprimer.

Si la date est > à 1 an on boucle. Arrivé au mois de décembre de la fin de l'année on revient au mois de janvier puis février etc jusqu'à décembre puis ensuite janvier tant de fois que necessaire.

Je ne sais pas quelle condition/fonction je dois ajouter pour faire cela.

En te remerciant,

C'est toujours difficile de rentrer dans le problème de quelqu'un d'autre.
Si je l'avais compris dès le début, probablement que j'aurais commencé par un code différent. Mais au stade où nous en sommes, et en espérant que j'ai bien compris avec ce que tu as ajouté sur les ratios, je te livre un code complété que, je te l'avoue, je n'ai pas testé.

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
Option Explicit
Sub TestCalculTotal()
  MsgBox CalculTotal(Range(Cells(2, 3), Cells(13, 3)), Cells(20, 3), Cells(21, 3)) & _
         " pour" & Chr(10) & "DateM = " & Cells(20, 3) & " et" & Chr(10) & "DateV = " & Cells(21, 3)
End Sub
Function CalculTotal(Pl As Range, DateM As Date, DateV As Date) As Currency
Dim Cell As Range
Dim RowNo As Long
Dim Mois As Integer, MoisM As Integer, MoisV As Integer
Dim RatioM, RatioV As Currency
Dim Annee As Integer
Dim Condition As Boolean
  MoisM = Format(DateM, "m")
  MoisV = Format(DateV, "m")
  RatioM = (DaysInMonth(Month(DateM), Year(DateM)) - Day(DateM)) / DaysInMonth(Month(DateM), Year(DateM))
  RatioV = (Day(DateV)) / DaysInMonth(Month(DateV), Year(DateV))
  CalculTotal = 0
  For Annee = Year(DateM) To Year(DateV)
    For Each Cell In Pl
      RowNo = Cell.Row
      Mois = Cells(RowNo, 1)
      If Year(DateM) = Year(Date) Then
        Condition = Mois >= MoisM And Mois <= MoisV
                                  Else
        If Annee = Year(DateM) Then
          Condition = Mois >= MoisM And Mois < 13
                               Else
          If Annee = Year(DateV) Then Condition = Mois <= MoisV And Mois > 0
        End If
      End If
      If Condition Then
        CalculTotal = CalculTotal + Cells(RowNo, Pl.Column) * RatioV * RatioM
        RatioM = 1
        RatioV = 1
      End If
    Next
  Next Annee
End Function
Public Function DaysInMonth(ByVal nMonth As Integer, ByVal nYear As Integer) As Integer
    DaysInMonth = Day(DateAdd("d", -1, DateAdd("m", 1, DateSerial(nYear, nMonth, 1))))
End Function

A mon âge, et après une journée de travail, je ne verrai probablement pas ta réaction avant demain. A voir l'heure à laquelle tu réponds, j'imagine que tu travailles la nuit et te réveilles l'après-midi quand je pense terminer ma journée ? Mais quoi qu'il en soit, je pense que tu as des éléments pour avancer par toi même.
Mais je reste disponible pour des coups de pouces à "horaire décalé"