Insérer Sous totaux VBA [Résolu]

[Yass34]

Bonjour Amis développeurs,


Je fais appel à vous afin de résoudre un petit problème que je rencontre !

Je construis actuellement sous VBA, un tableau d'amortissement d'emprunt.

Je souhaiterai insérer des sous totaux par année. Étant donné que chaque ligne correspond a un mois, je voudrais insérer une ligne "sous total de l'année x" toutes les 12 lignes à partir de A11. Les sous totaux concernent seulement les colonnes C,D,E (Intérêt, Amortissement, Mensualité).

Je me doute qu'il faut faire une boucle, mais je débute en VBA, et jai beaucoup de mal. Cela devrait être un jeu d'enfant pour vous

Merci d'avance

[jfontaine]

Bonjour,

Ci dessous une méthode

Code :

1
2
3
4
5
6
7
8
9
Dim ligne As Integer
 
For i = 1 To Round((Range("A65536").End(xlUp).Row - 10) / 12, 0)
    ligne = 11 + (12 * i) + i
    Rows(ligne).Insert
    Range("C" & ligne).FormulaLocal = "=somme(C" & ligne - 12 & ":C" & ligne - 1 & ")"
    Range("D" & ligne).FormulaLocal = "=somme(D" & ligne - 12 & ":D" & ligne - 1 & ")"
    Range("E" & ligne).FormulaLocal = "=somme(E" & ligne - 12 & ":E" & ligne - 1 & ")"
Next i

[Yass34]

Merci Jerome !

Que doit-je rajouter dans la boucle si je veux inscrire "sous total de l'année 1" par exemple dans la colonne A de chaque ligne ? Merci beaucoup !

[jfontaine]

Comme cela

Code :

1
2
3
4
5
6
7
8
9
10
11
Dim ligne As Integer
 
For i = 1 To Round((Range("A65536").End(xlUp).Row - 10) / 12, 0)
    ligne = 11 + (12 * i) + i
    Rows(ligne).Insert
    'Si A contient les Années
    Range("A" & ligne).Value = "Sous-Total Année : " & Range("A" & ligne-1).Value
    Range("C" & ligne).FormulaLocal = "=somme(C" & ligne - 12 & ":C" & ligne - 1 & ")"
    Range("D" & ligne).FormulaLocal = "=somme(D" & ligne - 12 & ":D" & ligne - 1 & ")"
    Range("E" & ligne).FormulaLocal = "=somme(E" & ligne - 12 & ":E" & ligne - 1 & ")"
Next i

[Yass34]

Encore un grand merci Jerome !

Cependant, après vérification sur mon tableau, je me suis rendu que quelque chose n'allait pas. En effet, la ligne sous total s'insère au mauvais endroit. En effet, au lieu de s'insérer après la 12em, 24em, 36 em ligne de mon tableau, elle s’insère une ligne trop bas (après la 13em, 25em, 36em...). Tout en sachant que la 1re ligne de mon tableau est en A11.

Ce doit être une petite correction de la boucle précédente. Encore merci

[jfontaine]

Essai en modifiant cette ligne (la ligne 11 contient bien la donnée de Janvier, pas le titre ?)

Code :

    ligne = 10 + (12 * i) + i

[Yass34]

Yes ! Cela fonctionne.

Mais je t’avoue que je ne comprends pas bien pourquoi, car la ligne A11 correspond bien a la première ligne de mon tableau, et non pas a l'en tête...

Sinon en ce qui concerne l'écriture dans la colonne A des sous totaux, cela fonctionne mais cela m'affiche "sous total de l'année 12" par exemple pour le premier sous total.

Or, mes lignes correspondent en fait à des mois, donc le sous total des 12 premières lignes doit correspondre au "sous total de l'année 1" et ainsi de suite, les 12 lignes suivantes puis "sous total de l'année 2" etc...

Aussi, est-il possible de rajouter un TOTAL général, à la fin du tableau d'amortissement ?

Merci de ton aide

[mercatog]

Si tu as les années en colonne B, tu peux utiliser le sous total offert par Excel.

Traduction en vba

Code :

1
2
3
4
5
6
7
8
9
Dim LastLig As Long
 
With Worksheets("Feuil4")
    .UsedRange.RemoveSubtotal
    LastLig = .Cells(.Rows.Count, "A").End(xlUp).Row
    .Range("A10:E" & LastLig).Subtotal GroupBy:=2, Function:=xlSum, _
        TotalList:=Array(3, 4, 5), Replace:=True, PageBreaks:=False, _
        SummaryBelowData:=True
End With

[Yass34]

Merci de ton aide !

J'avais pensé a cette solution mais non je n'ai pas de colonne avec les années, je ne peux donc pas utiliser la fonction offerte par Excel.

Un dernier appel à vos connaissances avant de définitivement fermer ce poste, j'aimerai rajouter à la fin de mon tableau d'amortissement, le Total général des 3 colonnes concernés. Que dois je rajouter à la macro suivante :

Code :

1
2
3
4
5
6
7
8
9
10
11
Dim ligne As Integer
 
For i = 1 To Round((Range("A65536").End(xlUp).Row - 10) / 12, 0)
    ligne = 11 + (12 * i) + i
    Rows(ligne).Insert
    'Si A contient les Années
    Range("A" & ligne).Value = "Sous-Total Année : " & Range("A" & ligne-1).Value
    Range("C" & ligne).FormulaLocal = "=somme(C" & ligne - 12 & ":C" & ligne - 1 & ")"
    Range("D" & ligne).FormulaLocal = "=somme(D" & ligne - 12 & ":D" & ligne - 1 & ")"
    Range("E" & ligne).FormulaLocal = "=somme(E" & ligne - 12 & ":E" & ligne - 1 & ")"
Next i

[jfontaine]

Une solution (code non testé)

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
 
Dim ligne As Integer
 
For i = 1 To Round((Range("A65536").End(xlUp).Row - 10) / 12, 0)
ligne = 11 + (12 * i) + i
Rows(ligne).Insert
'Si A contient les Années
Range("A" & ligne).Value = "Sous-Total Année : " & Range("A" & ligne-1).Value
Range("C" & ligne).FormulaLocal = "=somme(C" & ligne - 12 & ":C" & ligne - 1 & ")"
Range("D" & ligne).FormulaLocal = "=somme(D" & ligne - 12 & "" & ligne - 1 & ")"
Range("E" & ligne).FormulaLocal = "=somme(E" & ligne - 12 & ":E" & ligne - 1 & ")"
 
Next i
 
'Ajoute le total général
ligne = ligne +1
Range("A" & ligne).Value = "Total"
Range("C" & ligne).FormulaLocal = "=SOMME.SI(A11:A" & ligne -1 & ";""Sous-Total Année*"";C11:C" & ligne-1 & ")"
Range("D" & ligne).FormulaLocal = "=SOMME.SI(A11:A" & ligne -1 & ";""Sous-Total Année*"";D11:D" & ligne-1 & ")"
Range("E" & ligne).FormulaLocal = "=SOMME.SI(A11:A" & ligne -1 & ";""Sous-Total Année*"";E11:E" & ligne-1 & ")"

[Yass34]

Cela fonctionne ! Un grand merci à toi Jerome !

Re bonjour Jerome,

Je me permets de réouvrir ce post afin de compléter ma macro précédente. En effet je souhaiterai que les lignes des sous totaux aient un fond de couleur différent.

Après quelques recherches, la fonction Interior.ColorIndex revient souvent, jai fait quelques tentatives en l'insérant a différents endroits. Sans succès.

Pour info, la couleur souhaitée est le 2eme carré de la barre des violets en partant du plus claire (dans les fonds de couleur classique d'excel).

Merci d'avance

[jfontaine]

En effet pour changer la couleur de fond, tu peux utiliser Colorindex

Code :

1
2
3
4
5
6
7
8
'Ajoute le total général
ligne = ligne +1
Range("A" & ligne).Value = "Total"
Range("C" & ligne).FormulaLocal = "=SOMME.SI(A11:A" & ligne -1 & ";""Sous-Total Année*"";C11:C" & ligne-1 & ")"
Range("D" & ligne).FormulaLocal = "=SOMME.SI(A11:A" & ligne -1 & ";""Sous-Total Année*"";D11:D" & ligne-1 & ")"
Range("E" & ligne).FormulaLocal = "=SOMME.SI(A11:A" & ligne -1 & ";""Sous-Total Année*"";E11:E" & ligne-1 & ")"
 
Range("A" & ligne & ":E" & ligne).Interior.ColorIndex = 18

ci dessous une procédure qui ajoute une feuille avec la liste des couleurs et les numéro d'index.

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
Sub listeCouleurs()
 
Dim i As Integer
 
ActiveWorkbook.Sheets.Add Sheets(1)
ActiveWorkbook.Sheets(1).Select
ActiveWorkbook.Sheets(1).Name = "liste Couleur"
 
For i = 1 To 56
 
    Range("A" & i).Value = i
    Range("A" & i).Interior.ColorIndex = i
 
Next i
 
End Sub

[Yass34]

Merci Jerome !

Cette Macro fonctionne parfaitement pour le Total Général !

Cependant j'ai voulu la transposer aux lignes des sous totaux, et le résultat n'est pas probant !

Pourrais tu me donner la solution stp?

[jfontaine]

Code :

1
2
3
4
 
'Si A contient les Années
Range("A" & ligne).Value = "Sous-Total Année : " & Range("A" & ligne-1).Value
Range("A" & ligne & ":E" & ligne).Interior.ColorIndex = 18

[Yass34]

Merci Jerome !

Je ne voudrais pas abuser de ta gentillesse mais nous rencontrons à nouveau un petit problème.

Notre fonction qui permet de supprimer l'ancien tableau d'amortissement, afin d'en créer un nouveau par dessus est la suivante :

Code :

1
2
3
4
5
 
'Sélectionner les lignes à partir de la ligne 6 jusqu'à n ligne et les effacer
lastrow = ActiveSheet.UsedRange.Rows.Count ' pour trouver la dernière ligne du tableau
 
Rows("6:" & lastrow).ClearContents ' supprimer le tableau sélectionné

Cependant, cette fonction ne supprime le fond de couleur des anciennes lignes et pas non plus la police.

Sachant que la ligne total général n'est jamais au même endroit sur différent tableau, nous cherchons la fonction qui permet de supprimer les contenus des anciennes lignes mais aussi les anciens fonds de couleurs et les anciennes polices...

Merci d'avance

[mercatog]

Code :

Rows("6:" & lastrow).Clear

[Yass34]

Un grand merci à vous tous, ce forum est vraiment génial !

Bonne continuation,

Cordialement

Yaniss