Discussion :

[will-1981]

Bonjour,

J'aimerais réussir à faire un sous-total par code article sur une liste qui comporte énormement de code.
Bien entendu j'ai au préalable trié les données par code.
J'ai réalisé cette macro qui me permet d'obtenir un sous-total seulement comme j'insère une ligne juste après la dernière ligne de code trouvé afin de faire le sous total, je me retrouve avec une boucle for... next qui s'arrete à la derniere ligne avant de réaliser des insertions.
Admettons j'ai une liste 100 lignes comportant 5 codes, ça me fera donc 5 ligne à insérer (voir 4 ) pour chaque sous total. Or la fin de boucle s'arretra à la derniere ligne initiale soit à la 100 ème et non à la 104 ème.
J'ai pourtant dis que je souhaitais ajouter 1 à la variable de fin à chaque fois qu'il insère uen ligne mais ça ne change rien.

Pouvez vous m'aider, merci bien

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
 
Sub sstoto()
 
Dim PAT As Object
Set PAT = Sheets("Plan appro total")
 
Dim codearticle
derniereligne = PAT.Range("A3").End(xlDown).Row
z = 4
 
For z = 4 To derniereligne Step 1
 
        codearticle = PAT.Cells(z, 2)
 
        If codearticle <> PAT.Cells(z + 1, 2) Then
 
            lignesstoto = z + 1
            ptdepart = z - WorksheetFunction.CountIf(PAT.Columns("B:B"), codearticle)
 
            PAT.Rows("" & lignesstoto & "").Insert Shift:=xlDown
            PAT.Cells(lignesstoto, 2) = "Ss-Tt de " & codearticle
            PAT.Cells(lignesstoto, 3) = PAT.Cells(z, 3)
            PAT.Cells(lignesstoto, 4) = WorksheetFunction.SumIf(PAT.Columns("B:B"), codearticle, PAT.Columns("D:D"))
            PAT.Cells(lignesstoto, 7) = PAT.Cells(z, 7)
            PAT.Cells(lignesstoto, 8) = PAT.Cells(z, 8)
 
'recherhe si le produit est en rupture et renseigne la ligne ss total si c'est le cas
 
                For x = ptdepart To z Step 1
                    If PAT.Cells(x, 9) = "1 ère Rupture" Then
                    PAT.Cells(lignesstoto, 9) = "Rupture le " & PAT.Cells(x, 1)
                    End If
                Next
 
            PAT.Cells(lignesstoto, 10) = PAT.Cells(z, 10)
            PAT.Range("A" & lignesstoto & ":J" & lignesstoto & "").WrapText = True
            PAT.Range("A" & lignesstoto & ":J" & lignesstoto & "").Font.FontStyle = "Gras"
            PAT.Range("A" & lignesstoto & ":J" & lignesstoto & "").Font.ColorIndex = 41
            PAT.Range("A" & lignesstoto & ":J" & lignesstoto & "").Borders(xlEdgeTop).LineStyle = xlContinuous
            PAT.Range("A" & lignesstoto & ":J" & lignesstoto & "").Borders(xlEdgeTop).Weight = xlThin
            PAT.Range("A" & lignesstoto & ":J" & lignesstoto & "").Borders(xlEdgeBottom).LineStyle = xlContinuous
            PAT.Range("A" & lignesstoto & ":J" & lignesstoto & "").Borders(xlEdgeBottom).Weight = xlMedium
            PAT.Range("A" & lignesstoto & ":J" & lignesstoto & "").Interior.ColorIndex = 24
 
            z = z + 1
            derniereligne = derniereligne + 1
       End If
 
Next
 
End Sub

[will-1981]

finalement j'ai trouvé une solution qui me convient.

J'ai déclaré une valeur de fin = 50000 pour ma boucle afin de ne pas avoir à utiliser une variable

et j'ai rajouté une condition pour sortir de la boucle si il n'y avait pas de valeur dans la cellule (ce qui signifie la fin de la liste). Pour info voici le code :
Merci à ceux qui se sont interessé à mon problème.

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
 
Sub sstoto()
 
Dim PAT As Object
Set PAT = Sheets("Plan appro total")
 
Dim codearticle
derniereligne = PAT.Range("A3").End(xlDown).Row
z = 4
 
For z = 4 To 50000 Step 1
 
        codearticle = PAT.Cells(z, 2)
 
        If codearticle <> PAT.Cells(z + 1, 2) Then
 
            lignesstoto = z + 1
            ptdepart = z - WorksheetFunction.CountIf(PAT.Columns("B:B"), codearticle)
 
            PAT.Rows("" & lignesstoto & "").Insert Shift:=xlDown
            PAT.Cells(lignesstoto, 2) = "Ss-Tt du code : " & codearticle
            PAT.Cells(lignesstoto, 3) = PAT.Cells(z, 3)
            PAT.Cells(lignesstoto, 4) = WorksheetFunction.SumIf(PAT.Columns("B:B"), codearticle, PAT.Columns("D:D"))
            PAT.Cells(lignesstoto, 7) = PAT.Cells(z, 7)
            PAT.Cells(lignesstoto, 8) = PAT.Cells(z, 8)
            PAT.Cells(lignesstoto, 10) = PAT.Cells(z, 10)
            PAT.Range("A" & lignesstoto & ":J" & lignesstoto & "").WrapText = True
            PAT.Range("A" & lignesstoto & ":J" & lignesstoto & "").Font.FontStyle = "Gras"
            PAT.Range("A" & lignesstoto & ":J" & lignesstoto & "").Font.ColorIndex = 41
            PAT.Range("A" & lignesstoto & ":J" & lignesstoto & "").Borders(xlEdgeTop).LineStyle = xlContinuous
            PAT.Range("A" & lignesstoto & ":J" & lignesstoto & "").Borders(xlEdgeTop).Weight = xlThin
            PAT.Range("A" & lignesstoto & ":J" & lignesstoto & "").Borders(xlEdgeBottom).LineStyle = xlContinuous
            PAT.Range("A" & lignesstoto & ":J" & lignesstoto & "").Borders(xlEdgeBottom).Weight = xlMedium
            PAT.Range("A" & lignesstoto & ":J" & lignesstoto & "").Interior.ColorIndex = 24
 
'recherhe si le produit est en rupture et renseigne la ligne ss total si c'est le cas
 
                For x = ptdepart To z Step 1
                    If PAT.Cells(x, 9) = "1 ère Rupture" Then
                    PAT.Cells(lignesstoto, 9) = "Rupture le " & PAT.Cells(x, 1)
                    End If
                Next
 
            z = z + 1
        Else
        'condition pour sortir de la boucle lorsqu'il n'y a plus de valeur
                If PAT.Cells(z, 1) = "" Then
                    Exit For
                End If
        End If
 
Next
 
End Sub