[XL-2003] Sous totaux avec plusieurs conditions [Résolu]

[Maxgad]

Bonsoir,
Si quelqu'un peut m'aider svp
Je souhaiterai faire les sous totaux selon plusieurs If, dont 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
 
Sub Total_OPCVM()
    Application.ScreenUpdating = False
Dim DerLig As Long, LigneAjout As Long, i As Long, Valeur As Long
Dim var1 As Single, var2 As Single
Dim var3 As Variant
Dim var4 As Variant
Dim Compteur As Double
Dim Ws1 As Worksheet
Dim Ws2 As Worksheet
 
Sheets("Fluval").Select
    Set Ws1 = Worksheets("Fluval")
    Set Ws2 = Worksheets("total OPCVM")
    DerLig = Ws1.Range("A" & Ws1.Rows.Count).End(xlUp).Row
    LigneAjout = 1
 
    Ws2.Range("A:AL").ClearContents
    For i = 1 To DerLig
        Compteur = Compteur + Ws1.Range("V" & i).Value
        var1 = Ws1.Range("A" & i).Value 'colonne A
        var2 = Ws1.Range("A" & i).Offset(1, 0).Value ' colonne A
        var3 = Ws1.Range("K" & i).Value 'colonne K
        var4 = Ws1.Range("R" & i).Value ' colonne R
 
        If (var2 <> var1 And var3 = "3" And var4 = "PROPRE") Then
 
            Ws2.Range("A" & LigneAjout) = var1
            Ws2.Range("B" & LigneAjout) = Compteur
            Compteur = 0
            LigneAjout = LigneAjout + 1
 
        End If
        End If
     Next i
 
    Set Ws1 = Nothing
    Set Ws2 = Nothing
    End Sub

Mais le problème c'est que le total ne tient pas compte des deux conditions var3 = "3" And var4 = "PROPRE".
Comment faire svp
NB: le fichier joint a été simplifié, l'original fait plus de 4000 lignes
Merci

[gFZT82]

Bonjour,

Avec ton code tu effectues le cumul des valeurs de la colonne V de la feuille « fluval » et tu notes ce cumul dans la feuille « total OPCVM » dès que la valeur change dans la colonne A (var2 <> var1) et que les deux autres conditions (var3 = "3" et var4 = "PROPRE") sont remplies.

Donc, le total prend bien en compte les deux conditions var3 = "3" And var4 = "PROPRE".
Par contre, si ce n’est pas ce total qui t’intéresse, à toi de préciser ce que tu souhaites.

Par exemple, si tu souhaites effectuer le cumul des seules lignes qui remplissent la condition var3 = "3" And var4 = "PROPRE", la condition var2 <> var1 n’a plus lieu d’être.

Cordialement.

[Maxgad]

Bonjour et merci pour ta réponse. Tu as très bien décris ce que je souhaite sauf que Ca ne marche pas. Le code me fait bien le total suivant des que la colonne a change de valeur mais les conditions var2 et var3 ne sont pas prises en compte. En faite, je souhaite faire le total des que la colonne A change de valeur mais faire le total uniquement des lignes ou var3 et var4 est présent. Merci encore

[gFZT82]

Dans ton exemple la valeur de la colonne A change à la ligne 6.
Quel résultat attends-tu ?
Le cumul issu de toutes les lignes qui remplissent la condition var3 = "3" And var4 = "PROPRE", soit 17 158 293,86 ?

Cordialement.

[Maxgad]

Merci encore
Voici le résultat attendu
300031 16 146 593,86 'total lignes avec code 300031 avec var3 et var4 ok
300168 1 011 700,00 'total lignes avec code 300168 avec var3 et var4 ok
Merci encore.

[gFZT82]

Essaie avec ce 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
Sub Total_OPCVM()
Dim DerLig As Long, LigneAjout As Long, i As Long, Valeur As Long
Dim var1 As Single, var2 As Single
Dim var3 As Variant
Dim var4 As Variant
Dim Compteur As Double
Dim Ws1 As Worksheet
Dim Ws2 As Worksheet
 
Application.ScreenUpdating = False
Sheets("Fluval").Select
    Set Ws1 = Worksheets("Fluval")
    Set Ws2 = Worksheets("total OPCVM")
    DerLig = Ws1.Range("A" & Ws1.Rows.Count).End(xlUp).Row
    LigneAjout = 1
 
    Ws2.Range("A:AL").ClearContents
    For i = 1 To DerLig
        var1 = Ws1.Range("A" & i).Value 'colonne A
        var2 = Ws1.Range("A" & i).Offset(1, 0).Value ' colonne A
        var3 = Ws1.Range("K" & i).Value 'colonne K
        var4 = Ws1.Range("R" & i).Value ' colonne R
        If var3 = 3 And var4 = "PROPRE" Then
            Compteur = Compteur + Ws1.Range("V" & i).Value
        End If
        If var2 <> var1 Then
            Ws2.Range("A" & LigneAjout) = var1
            Ws2.Range("B" & LigneAjout) = Compteur
            Compteur = 0
            LigneAjout = LigneAjout + 1
        End If
    Next i
    Set Ws1 = Nothing
    Set Ws2 = Nothing
    End Sub

Cordialement.

[Maxgad]

Magnifique
Merci infiniment l'ami et vive le Forum..