Insérer ligne et sous totaux avec vba

Version imprimable

02/11/2011, 23h10
T17LR

Insérer ligne et sous totaux avec vba

Bonsoir à tous,

Je me lance en VBA et j'avoue que ce n'est pas évident :cry:

je vous expose mon problème en ésperant avoir la solution.

je traite un tableau avec 5 colonnes avec en-têtes.

Colonne A : montants
Colonne C : liste de noms que j'ai trié au préalable.
je peux donc avoir dans cette colonne :
en C2 : dupont
en C3 : dupont
en C4 : dupont
en C5 : martin
en C6 : martin
etc...

je voudrais :
1/ insérer une ligne à chaque changement de nom, sachant que ce ficher et la liste de nom n'est pas identique d'un jour à l'autre. je ne connais pas le nombre de lignes de mon tableau.

2/faire des sous totaux au niveau de chaque ligne insérée dans la colonne A

Je suis débutant et j'aimerais arriver au bout de mon auto-formation.

Je vous remercie pour le temps que vous consacrerez à ma demande...

Bonjour,

Ci dessous une solution

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
Sub SousTotaux()
Dim i As Long
Dim Iprec As Long
Dim strNom As String
 
i = 2
'Boucle sur tant que la colonne A n'est pas vide
Do While Range("A" & i).Value <> ""
    'Si nom de la ligne <> du nom precedent
    If strNom <> Range("C" & i).Value Then
        If strNom <> "" Then
            'insere une ligne
            Rows(i).Insert
            'insere la somme
            Range("A" & i).FormulaLocal = "=somme(A" & Iprec & ":A" & i - 1 & ")"
            'mémorise la ligne de début e la prochaine section
            Iprec = i + 1
        End If
        Iprec = i
        strNom = Range("C" & i).Value
    End If
    i = i + 1
Loop
'insere la dernière formule
Range("A" & i).FormulaLocal = "=somme(A" & Iprec & ":A" & i - 1 & ")"
 
End Sub

02/11/2011, 23h34
T17LR

Merci beaucoup, c'est exactement ce que je voulais. EXCELLENT !!!!
Cependant j'aurais une autre faveur a te demander :
Dans les lignes que j'ai inséré je voudrais copier le contenu de la dernière ligne. Exemple :
sur la ligne des totaux dupont, reporter le texte dans la ligne du dessus et le mettre en gras.

et si possible masquer les lignes avec les details.

Voila

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 SousTotaux()
Dim i As Long
Dim Iprec As Long
Dim strNom As String
 
i = 1
'Boucle sur tant que la colonne A n'est pas vide
Do While Range("A" & i).Value <> ""
    'Si nom de la ligne <> du nom precedent
    If strNom <> Range("C" & i).Value Then
        If strNom <> "" Then
            'insere une ligne
            Rows(i).Insert
            'insere la somme
            Range("A" & i).FormulaLocal = "=somme(A" & Iprec & ":A" & i - 1 & ")"
            'Ajoute le nom en C
            Range("C" & i).Value = strNom
            Range("C" & i).Font.Bold = True
            'Regroupe les lignes
            Rows(Iprec & ":" & i - 1).Group
            'mémorise la ligne de début e la prochaine section
            Iprec = i + 1
        Else
            Iprec = i
        End If
        strNom = Range("C" & i + 1).Value
    End If
    i = i + 1
Loop
'insere la dernière formule
Range("A" & i).FormulaLocal = "=somme(A" & Iprec & ":A" & i - 1 & ")"
Range("C" & i).Value = strNom
Range("C" & i).Font.Bold = True
Rows(Iprec & ":" & i - 1).Group
End Sub

03/11/2011, 21h21
T17LR

Une 2ème excellente réponse ! Net et précis.

Merci

Bonsoir,

Après quelques tests sur ce programmme, j'ai constaté ce qui suit :

1/ Je peux refaire la boucle plusieurs fois. Or, le traitement se fait en une seule fois et si je relance accidenentellemet, cela fausse tout. :(

2/ Je n'arrive pas à faire le total général de toutes les sommes (nombre d'argument trop important).

Ceci me dépasse :cry:

Y a t-il un moyen pour palier à ca?

Merci de vos réponse.
03/11/2011, 21h29
jfontaine
Citation:

1/ Je peux refaire la boucle plusieurs fois. Or, le traitement se fait en une seule fois et si je relance accidenentellemet, cela fausse tout.

pour eviter cea, il te faut tester si le code a déja tourné. Par exemple en testant si la ligne 2 est groupé
Code:

1 2 i=2 If Rows(i).Group = True Then Exit Sub
Citation:

2/ Je n'arrive pas à faire le total général de toutes les sommes (nombre d'argument trop important).

Quel code a tu mis?
03/11/2011, 21h34
T17LR
Citation:
Envoyé par jfontaine

pour eviter cea, il te faut tester si le code a déja tourné. Par exemple en testant si la ligne 2 est groupé

Code:

1 2 i=2 If Rows(i).Group = True Then Exit Sub
ok j'essaye ca !

Citation:

Envoyé par jfontaine

Quel code a tu mis?

j'ai pas mis de code, j'ai juste fait un total "à la main" des sous-totaux dans les lignes groupés

Bonsoir
Tu ne peux pas utiliser le sous total offert par Excel?

Code:

1
2
3
4
5
6
7
Sub SousTotal()
 
With Worksheets("Feuil4").Range("A:E")
    .RemoveSubtotal
    .Subtotal GroupBy:=3, Function:=xlSum, TotalList:=Array(1), Replace:=True, SummaryBelowData:=True
End With
End Sub

03/11/2011, 22h11
jfontaine

Mercatog a raison, le plus simple est de passer par ce qui existe. :ccool:

Méa culpa, je suis partie la tête dans le guidon, du coup, j'ai oublié les sous-totaux d'Excel :oops::oops::oops:
05/11/2011, 16h03
T17LR

bonjour,

Merci de vos interventions.

En effet, la solution proposée par mercatog me va parfaitement ! par contre, je souhaiterais reporter sur les lignes des sous totaux toutes les données de la ligne précedente (pour les colonnes B, D et E).

Code:

1
2
3
4
5
6
7
Sub SousTotal()
 
With Worksheets("Feuil4").Range("A:E")
    .RemoveSubtotal
    .Subtotal GroupBy:=3, Function:=xlSum, TotalList:=Array(2, 4, 5), Replace:=True, SummaryBelowData:=True
End With
End Sub

07/11/2011, 00h03
T17LR

Les colonnes B,D et E ne contiennent pas des chiffres mais des noms, dates... du coup j'ai des zéros.

De plus sur la colonne C, j'ai une liste de noms, après l'execution des sous totaux, il me mets : total Martin, total Dupont. Je voudrais qu'il me reporte que le nom (ou la date suivant les colonnes).