Compteur Macro VBA

Version imprimable

Compteur Macro VBA

Bonjour,

Je présente tout d'abord la situation :

Sur La colonne 3 on a notre référence r.
Sur la colonne 4 on a nos valeurs.
Je somme les valeurs de la colonne 4 en partant vers le bas de la cellule sur la même ligne que la référence et cette somme doit être inférieure ou égale à notre référence.
J'injecte ensuite dans ce calcul un compteur J pour me donner le nombre de lignes sur lesquelles la somme s'est faite.
Ensuite avec J je retrouve la ligne juste après la dernière ligne sommé : Tout ça pour car en fait moi depuis le début ce que je recherche c'est de sommer les valeurs de la colonne 4 pour avoir une somme juste au dessus de ma référence.

Le soucis que j'ai c'est que j'ai remarqué en regardant la valeur de mon J c'est que l'itération continue jusqu'à la première ligne alors que moi je veux qu'elle s'arrête à la ligne où la condition c'est plus satisfaite ( voir le code ).

Merci pour votre aide.
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 42 Sub calcul() Dim f As Long, r As Long, C As Long, J As Long f = ActiveCell.Row r = Cells(f, 3).Value C = 0 J = 0 For i = f To 2 Step -1 If C + Cells(i, 4).Value <= r Then C = C + Cells(i, 4): Cells(f, 14) = C J = J + 1 End If Next i Cells(f, 18) = J X = f - J Cells(f, 19) = X If Cells(X, 4) <> "" Then Cells(f, 15).Value = Cells(f, 14).Value + Cells(X, 4).Value Else MsgBox "Données historiques insuffisantes" Cells(f, 15) = Cells(f, 14) * (J + 1) / J Cells(f, 11).Interior.Color = RGB(255, 165, 0) End If Cells(f, 14).EntireColumn.Hidden = False Cells(f, 15).EntireColumn.Hidden = False Cells(f, 16) = Cells(f, 3) / (Cells(f, 15) / (J + 1)) Cells(f, 16).EntireColumn.Hidden = False Cells(f, 11) = Cells(f, 16) End Sub

05/04/2016, 16h41
Kimy_Ire

Bonjour Kiouane,

Quel est l'intérêt d'ouvrir deux sujets de conversation distincts abordant le même sujet, la même question ?
Ici, tu exposes déjà ton problème. Tu aurais pu simplement le compléter afin que les membres de la communauté puisse te répondre...

Bref...

Code:

1
2
3
     If C + Cells(i, 4).Value <= r Then
     C = C + Cells(i, 4): Cells(f, 14) = C: J = J + 1
     End If

Ca devrait fonctionner.

05/04/2016, 16h43
Kiouane

Je m'en excuse. Je vais clore l'autre sujet.
05/04/2016, 16h46
Kiouane

Merci pour ta réponse Thebenoit,

Mais c'est toujours la même chose.

Citation:

Envoyé par Kiouane

Je somme les valeurs de la colonne 4 en partant vers le bas de la cellule sur la même ligne que la référence et cette somme doit être inférieure ou égale à notre référence.

...
Tout ça pour car en fait moi depuis le début ce que je recherche c'est de sommer les valeurs de la colonne 4 pour avoir une somme juste au dessus de ma référence.

Salut, par contre j'ai un doute la somme elle doit être au dessus ou en dessous de la référence ?

Tu peux déjà regarder çà :
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 Dim f As Long, r As Long, C As Long, J As Long f = ActiveCell.Row r = Cells(f, 3).Value C = 0 J = 0 Do While C < r C = C + Cells(f, 4) f = f + 1 J = J + 1 Loop
Ce n'est que la partie qui fait la somme jusqu'à dépasser le ref et en plus on comptabilise ne nbre de valeurs dans la variable J.

En espérant que ce soit ce que tu cherches.

Ce n'est pas vraiment ce dont j'avais besoin mais tu m'as guidé vers la bonne voie.

Je vous montre le code.

Encore merci beaucoup.
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 42 Sub calcul() Dim f As Long, r As Long, C As Long, J As Long f = ActiveCell.Row r = Cells(f, 3).Value C = 0 J = 0 i = f Do Until C + Cells(i, 4).Value >= r C = C + Cells(i, 4): Cells(f, 14) = C i = i - 1 J = J + 1 Loop Cells(f, 18) = J X = f - J Cells(f, 19) = X If IsNumeric(Cells(X, 4)) Then Cells(f, 15).Value = Cells(f, 14).Value + Cells(X, 4).Value Else MsgBox "Données historiques insuffisantes" Cells(f, 15) = Cells(f, 14) * (J + 1) / J Cells(f, 11).Interior.Color = RGB(255, 165, 0) End If Cells(f, 14).EntireColumn.Hidden = true Cells(f, 15).EntireColumn.Hidden = true Cells(f, 16) = Cells(f, 3) / (Cells(f, 15) / (J + 1)) Cells(f, 16).EntireColumn.Hidden = true Cells(f, 11) = Cells(f, 16) End Sub
Je me suis précipité. J'ai un message sur la ligne du code suivant :

Code:

Do Until C + Cells(i, 4).Value >= r

dans le cas où il n'y a qu'une seule valeur sur la colonne 4

Je m'explique j'ai dans la colonne 4 par exemple sur la ligne f, la valeur : 300
et sur la colonne 3 sur la ligne f, la valeur : 2000

le do until n'a plus aucun sens car la condition est directement dépassée puisque 300 <= 2000

j'ai essayé de faire cette manipulation mais en vain
Code:

1 2 3 4 5 6 7 8 9 10 11 If IsNumeric(Cells(i - 1, 4)) Then Do Until C + Cells(i, 4).Value >= r C = C + Cells(i, 4): Cells(f, 14) = C i = i - 1 J = J + 1 Loop End If

Je crois que là c'est bon.

Encore merci beaucoup à tous.

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
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
Sub calcul()
 
 
Dim f As Long, r As Long, C As Long, J As Long
 
f = ActiveCell.Row
r = Cells(f, 3).Value
 
C = 0
J = 0
i = f
 
If Not IsEmpty(Cells(i - 1, 4)) Then
 
     If IsNumeric((Cells(i - 1, 4))) Then
 
 
           Do Until C + Cells(i, 4).Value >= r
           C = C + Cells(i, 4): Cells(f, 14) = C
           i = i - 1
           J = J + 1
           Loop
 
           Cells(f, 18) = J
           X = f - J
           Cells(f, 19) = X
 
               If IsNumeric(Cells(X, 4)) Then
 
                  Cells(f, 15).Value = Cells(f, 14).Value + Cells(X, 4).Value
 
               Else
 
                  MsgBox "Données historiques insuffisantes"
                  Cells(f, 15) = Cells(f, 14) * (J + 1) / J
                  Cells(f, 11).Interior.Color = RGB(255, 165, 0)
               End If
 
           Cells(f, 14).EntireColumn.Hidden = False
           Cells(f, 15).EntireColumn.Hidden = False
           Cells(f, 16) = Cells(f, 3) / (Cells(f, 15) / (J + 1))
           Cells(f, 16).EntireColumn.Hidden = False
 
 
           Cells(f, 11) = Cells(f, 16)
 
      Else
 
           MsgBox "Données historiques insuffisantes"
 
           Cells(f, 11).Interior.Color = RGB(255, 165, 0)
           Cells(f, 11) = Cells(f, 3) / Cells(f, 4)
      End If
 
Else
 
    MsgBox "Données historiques insuffisantes"
    Cells(f, 11).Interior.Color = RGB(255, 165, 0)
    Cells(f, 11) = Cells(f, 3) / Cells(f, 4)
 
End If
 
 
 
End Sub

06/04/2016, 11h48
Kiouane
Décidément en testant tous les cas je tombe sur un truc.

En fait j'explique :

Sur la cellule r = cells(f,3) j'ai la valeur suivante : 2000
sur les cellules cells(f-1,4) : 1200
cells(f-2,4) : 600

Puis sur les autres cellules de la colonne 4, elles sont Empty.

Du coup mon code bug à cet endroit
Code:

1 2 3 4 5 Do Until C + Cells(i, 4).Value >= r C = C + Cells(i, 4): Cells(f, 14) = C i = i - 1 J = J + 1 Loop
parceque en fait la condition inférieure à r est toujours satisfaite du coup je me retrouve avec une boucle infini.

Bon cette je clôture le sujet.

Il suffisait que je rajoute cette condition :

Code:

1
2
3
4
5
6
7
8
Do Until C + Cells(i, 4).Value >= r
           C = C + Cells(i, 4): Cells(f, 14) = C
           i = i - 1
           J = J + 1
           If Not IsNumeric(Cells(i, 4)) Then
           Exit Do
           End If
           Loop

Encore merci à tous le monde.