Discussion :

[mdimagho]

Bonjour
Dans le cas d'un calcul d'une fonction de Somme particulière, je me bloque !

en effet je voulais calculer la somme des valeurs successives et qui sont décalés au plus de deux 0 des cases B et les mettre dans C

Exemple : ma table Excel est la suivante
je veux calculer la somme de la case B1 et B2 B5 vu que B5 et Bé sont séparés que par deux 0 .
pour la B5 je mets simplement sa valeur dans C

A	B	C

1	100	450
2	200
3	0
4	0
5	150
6	0
7	0
8	0
9	0
10	0
11	250	250
12	0
13	0
14	0
15	100
16	0
17	200	300
18	0
19	0  
20	0

j'ai déja une macro qui calcule bien la somme mais qui ne tient pas compte de la somme totale si les valeurs sont séparés par au plus deux 0

voici la macro:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Sub Somme()
    Dim I As Long, nbLignes As Long
    Dim Total As Long
 
    nbLignes = Cells(Rows.Count, "A").End(xlUp).Row
 
    For I = 2 To nbLignes + 1
        If Range("B" & I) > 0 Then
            Total = Total + Range("B" & I)
        Else
            If Total > 0 Then Range("C" & I - 1) = Total
            Total = 0
        End If
    Next
End Sub

j'ai essayé de la modifié mais en vain .

Pouvez vous m' aidez ?

Merci beaucoup

[NVCfrm]

bonjour,
tu peux essayer ce code, en t'inspirant des structures de décision adapter les conditions si elles ne correspondent pas à ce que j'ai cru comprendre.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
 
Sub Somme()
    Dim I As Long, nbLignes As Long
    Dim Total As Long
    Dim condZero As Integer, totTmp As Long, totGLigne As Long, rSum As Range, tmp
 
    nbLignes = Cells(Rows.Count, "A").End(xlUp).Row
 
    Set rSum = Range("B1:B" & nbLignes)
    tmp = rSum
    totGLigne = 1
 
    Do
        I = I + 1
        totTmp = totTmp + rSum.Cells(I, 1)
        condZero = condZero + (rSum.Cells(I, 1) = 0) > 0
        If (rSum.Cells(I + 1, 1) > 0 Or I + 1 > nbLignes) And condZero = 2 Then
            rSum.Cells(totGLigne, 2) = totTmp
            Total = Total + totTmp
            totTmp = 0
            totGLigne = I + 3
            I = I + 2
            condZero = 0
        ElseIf I + 1 > nbLignes Then
            rSum.Cells(totGLigne, 2) = totTmp
            Total = Total + totTmp
        ElseIf rSum.Cells(I, 1) > 0 Then
            condZero = 0
        End If
 
    Loop Until I = nbLignes
 
    rSum.Cells(2, 3) = Total
End Sub

[Invité]

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
Sub test()
Dim offset As Long
Dim NbZero As Integer
Dim L As Long
Dim R As Range
Set R = ActiveSheet.UsedRange
NbZero = 3
For L = 2 To R.Rows.Count
    If R(L, 2) <> 0 Then
        If NbZero > 2 Then offset = L:  R(offset, 3) = 0
        NbZero = 0
        R(offset, 3) = R(offset, 3) + R(L, 2)
    Else
        NbZero = NbZero + 1
    End If
Next
MsgBox "Fin"
End Sub

[mdimagho]

Bonjour,

Merci ça marche

est c'est possible de calculer l' écart entre chaque deux somme consécutifs ?
exemple entre les 2 sommes calculés 450 et 25O je voulais qu'il m' affiche 10 ( A11 -A1) !

Merci beaucoup pour votre aide

[Theze]

Bonjour,

Teste ceci et adapte :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
 
Sub Ajouter()
 
    Dim Plage As Range
    Dim Total As Long
    Dim TotalGeneral As Long
    Dim Zero As Integer
    Dim I As Integer
    Dim J As Integer
 
    'défini la plage sur la colonne B
    With ActiveSheet
 
        Set Plage = .Range(.Cells(1, 2), .Cells(.Rows.Count, 2).End(xlUp))
 
    End With
 
    'parcours la plage
    For I = 1 To Plage.Count
 
        J = J + 1
 
        'si > à 0
        If Plage(I, 1).Value > 0 Then
 
            Total = Total + Plage(I, 1).Value
 
            'si le il n'y a qu'un 0 qui sépare les deux nombres, inscrit en C
            If Zero = 1 Then
 
                'inscrit le sous-total en colonne C
                Plage(I, 1).offset(, 1).Value = Total 'cas de la somme de 100+200
                Plage(I, 1).offset(, 2).Value = J - 1 '<--- à adapter
                J = 0
 
                'totalise
                TotalGeneral = TotalGeneral + Total
 
                'ré-initialise
                Total = 0
                Zero = 0
 
 
            End If
 
            'si le il n'y a que deux 0 qui séparent les deux nombres, inscrit en C
            If Zero = 2 Then
 
                'inscrit le sous-total en colonne C
                Plage(I, 1).offset(, 1).Value = Total 'cas de la somme de 100+200+150 et de 250 seul
 
                'inscrit l'écart
                Plage(I, 1).offset(, 2).Value = J - 1 '<--- à adapter
                J = 0
 
                'totalise
                TotalGeneral = TotalGeneral + Total
 
                'ré-initialise
                Total = 0
                Zero = 0
 
            End If
 
        Else
 
            'compte le nombre de 0
            Zero = Zero + 1
 
        End If
 
        'évite d'aller au delà de 2
        If Zero > 2 Then Zero = 0
 
    Next I
 
    'inscrit le total dans la cellule D1
    Cells(1, 4).Value = TotalGeneral
 
End Sub

Hervé.

[Invité]

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Sub test()
Dim offset As Long
Dim NbZero As Integer
Dim L As Long
Dim R As Range
Set R = ActiveSheet.UsedRange
NbZero = 3
For L = 2 To R.Rows.Count
    If R(L, 2) <> 0 Then
        If NbZero > 2 Then
        If offset <> 0 Then
            R(offset, 4).Formula = Replace("=""Cells(" & R(offset, 1).Address & ":" & R(L, 1).Address & ")=""&" & R(offset, 3).Address & " - " & R(L, 3).Address, "$", "")
            offse2 = offset
         End If
            offset = L:  R(offset, 3) = 0
 
            End If
        NbZero = 0
         R(L, 3) = ""
        R(offset, 3) = R(offset, 3) + R(L, 2)
    Else
        NbZero = NbZero + 1
         R(L, 3) = ""
         R(L, 4) = ""
    End If
Next
If offset <> 0 And offset < L - 1 Then R(offset, 4).Formula = Replace("=""Cells(" & R(offset, 1).Address & ":" & R(L - 1, 1).Address & ")=""&" & R(offset, 3).Address & " - " & R(L - 1, 3).Address, "$", "")
MsgBox "Fin"
End Sub

[mdimagho]

Merci à votre réponse rapide !

Votre truc a l' air de marcher
Par contre j'arrive pas à extraire le bout du code dans le macro qui sert à calculer la différence
en effet j'ai fait macro1 pour calculer chaque somme pour chaque branche
et la macro 2 c'est pour calculer la différence.


en effet à travers votre 2 ème macro , je vais m'inspirer pour la modifier afin de calculer l' écart entre 2 colonnes dont chaque une calcule une somme
et de me donner le résultat en fonction de la colonne A

en effet la colonne A un échelle de temps , B =Somme 1 , C= Somme 2

je voulais calculer ce lapse de temps qui sépare l apparition de de ces deux sommes

ex:

A(en seconde)	B	C

1		500	0
2		0	0
3		0	0
4		0	100
5
6
7
8
9
10

ceci va me donner dans une colonne D que le lapse de temps entre l'apprtion de la somme en B et la somme en C c'est (4s-1s) = 3s

je vous remercie beaucoup pour votre aide