Somme dynamique de totaux sous totaux de lignes

[mathieums]

Bonjour à tous et merci par avance pour vos futurs réponses,

Je souhaiterais effectuer une somme de sous totaux et totaux en dynamique en fonction des lignes.

Ces lignes, sous totaux et totaux n'auront pas forcement le même positionnement en fonction du temps.

J'ai préparé un fichier pour que ce soit en peu plus parlant.

Vous le trouverez en pj.

Idéalement je souhaiterais le faire dans une macro

THX.

A+
Mathieu

 

[chris]

Re : Somme dynamique de totaux sous totaux de lignes

Bonjour

Quel est l'intérêt de le faire par macro puisque de bêtes somme automatiques fonctionnent ?

Ou alors je n'ai pas tout compris...

 

[mathieums]

Re : Somme dynamique de totaux sous totaux de lignes

La restitution des lignes se fait par une première macro et j'aimerais rajouter dans cette macro le code pour le calcul des sommes en dynamique.

Cordialement,

Mathieu

 

[chris]

Re : Somme dynamique de totaux sous totaux de lignes

Re

Dans ce cas poste la macro pour qu'on voit où compléter...

 

[klin89]

Re : Somme dynamique de totaux sous totaux de lignes

Bonsoir chris, mathieums
Bonsoir le forum,

Pourquoi faire simple quand on peut faire compliqué
En considérant que la ligne d'en-tête est bien la ligne 3 :
Ici, j'insère une ligne de sous-totaux à chaque changement d'occurence dans la colonne C puis fait le total en bas du tableau.

Sub SousTotaux()
Dim j As Long, Lgdep As Long, LgFin As Long
Dim tot1 As Integer, tot2 As Integer, tot3 As Integer, tot4 As Integer
Application.ScreenUpdating = False
Lgdep = Feuil1.Range("C" & Rows.Count).End(xlUp).Row + 1
With Feuil1
  For j = Lgdep - 1 To 5 Step -1
    If .Range("C" & j) <> .Range("C" & j - 1) Then
      .Range("C" & Lgdep).Value = .Range("C" & j).Value
      .Range("D" & Lgdep).Value = "Sous Total"
      .Range("E" & Lgdep).Formula = "=SUM(R" & j & "C:R" & Lgdep - 1 & "C)"
      .Range("F" & Lgdep).Formula = "=SUM(R" & j & "C:R" & Lgdep - 1 & "C)"
      .Range("G" & Lgdep).Formula = "=SUM(R" & j & "C:R" & Lgdep - 1 & "C)"
      .Range("H" & Lgdep).Formula = "=SUM(R" & j & "C:R" & Lgdep - 1 & "C)"
      tot1 = tot1 + .Range("E" & Lgdep).Value: tot2 = tot2 + .Range("F" & Lgdep).Value
      tot3 = tot3 + .Range("G" & Lgdep).Value: tot4 = tot4 + .Range("H" & Lgdep).Value
      .Range("C" & j & ":H" & j).Insert shift:=xlShiftDown
      Lgdep = j
    End If
  Next j
  If Lgdep > 4 Then
    .Range("C" & Lgdep).Value = .Range("C" & j).Value
    .Range("D" & Lgdep).Value = "Sous Total"
    .Range("E" & Lgdep).Formula = "=SUM(R" & j & "C:R" & Lgdep - 1 & "C)"
    .Range("F" & Lgdep).Formula = "=SUM(R" & j & "C:R" & Lgdep - 1 & "C)"
    .Range("G" & Lgdep).Formula = "=SUM(R" & j & "C:R" & Lgdep - 1 & "C)"
    .Range("H" & Lgdep).Formula = "=SUM(R" & j & "C:R" & Lgdep - 1 & "C)"
  End If
  tot1 = tot1 + .Range("E" & Lgdep).Value: tot2 = tot2 + .Range("F" & Lgdep).Value
  tot3 = tot3 + .Range("G" & Lgdep).Value: tot4 = tot4 + .Range("H" & Lgdep).Value
  LgFin = Feuil1.Range("C" & Rows.Count).End(xlUp).Row + 1
  .Range("C" & LgFin).Value = "Total"
  .Range("E" & LgFin).Value = tot1
  .Range("F" & LgFin).Value = tot2
  .Range("G" & LgFin).Value = tot3
  .Range("H" & LgFin).Value = tot4
End With
Application.ScreenUpdating = True
End Sub

Je n'ai peut-être rien compris

Klin89

 

[job75]

Re : Somme dynamique de totaux sous totaux de lignes

Bonjour mathieums, chris, klin89,

Voyez le fichier joint avec cette macro :

Sub Totaux()
Dim plage As Range, ncol As Integer, i As Long
Set plage = Range("C3:C" & Cells(Rows.Count, "C").End(xlUp).Row + 1)
ncol = Cells(2, Columns.Count).End(xlToLeft).Column - 4
Application.ScreenUpdating = False
'---suppression des lignes TOTAL et S/TOTAL---
plage.AutoFilter 1, "*TOTAL*"
plage.Offset(1).SpecialCells(xlCellTypeVisible).EntireRow.Delete
plage.AutoFilter
'---création de la ligne TOTAL---
With plage(plage.Rows.Count)
  .Offset(-1).EntireRow.Copy .EntireRow 'pour les formats
  .EntireRow.ClearContents
  .Value = "TOTAL"
  .Offset(, 2).Resize(, ncol).FormulaR1C1 = _
    "=SUM(R4C:R[-1]C)-SUMIF(R4C3:R[-1]C3,""S/*"",R4C:R[-1]C)"
End With
'---insertion des lignes S/TOTAL---
For i = plage.Rows.Count To 3 Step -1
  If plage(i) <> plage(i - 1) Then
    plage(i).EntireRow.Insert
    plage(i) = "S/TOTAL " & plage(i - 1)
    plage(i).Offset(, 2).Resize(, ncol).FormulaR1C1 = _
      "=SUM(R4C:R[-1]C)-2*SUMIF(R4C3:R[-1]C3,""S/*"",R4C:R[-1]C)"
  End If
Next
'--suppression des formules (facultatif)---
plage.Resize(, ncol + 2) = plage.Resize(, ncol + 2).Value
End Sub

Les lignes TOTAL et S/TOTAL sont insérées avec les formules adéquates.

Pour les voir, mettez l'avant-dernière ligne de la macro en commentaire.

Important : les mots "TOTAL" et "S/TOTAL" sont toujours en colonne C.

A+

 

[job75]

Re : Somme dynamique de totaux sous totaux de lignes

Re,

Ah, une ligne était supprimée... Utilisez cette macro corrigée :

Sub Totaux()
Dim plage As Range, ncol As Integer, i As Long
Set plage = Range("C3", Cells(Rows.Count, "C").End(xlUp))
ncol = Cells(2, Columns.Count).End(xlToLeft).Column - 4
Application.ScreenUpdating = False
'---suppression des lignes TOTAL et S/TOTAL---
plage.AutoFilter 1, "*TOTAL*"
plage.Offset(1).SpecialCells(xlCellTypeVisible).EntireRow.Delete
plage.AutoFilter
'---création de la ligne TOTAL---
Set plage = plage.Resize(plage.Rows.Count + 1) 'avec ligne vide
With plage(plage.Rows.Count)
  .Offset(-1).EntireRow.Copy .EntireRow 'pour les formats
  .EntireRow.ClearContents
  .Value = "TOTAL"
  .Offset(, 2).Resize(, ncol).FormulaR1C1 = _
    "=SUM(R4C:R[-1]C)-SUMIF(R4C3:R[-1]C3,""S/*"",R4C:R[-1]C)"
End With
'---insertion des lignes S/TOTAL---
For i = plage.Rows.Count To 3 Step -1
  If plage(i) <> plage(i - 1) Then
    plage(i).EntireRow.Insert
    plage(i) = "S/TOTAL " & plage(i - 1)
    plage(i).Offset(, 2).Resize(, ncol).FormulaR1C1 = _
      "=SUM(R4C:R[-1]C)-2*SUMIF(R4C3:R[-1]C3,""S/*"",R4C:R[-1]C)"
  End If
Next
'--suppression des formules (facultatif)---
plage.Resize(, ncol + 2) = plage.Resize(, ncol + 2).Value
End Sub

Fichier (2).

A+

 

[mathieums]

Re : Somme dynamique de totaux sous totaux de lignes

Je viens de voir vos réponses, désolé un peu tard.

je vous remercie tous énormément pour vos exemples de macro.

A+
Mathieu