si ligne supprimée, le sous total ne bouge pas?!

[fopynem]

Salut à tout le forum

voilà g fait une macro qui me permet de trier mes donnees puis de me faire des sous totaux lorsque
-les montants sont supérieurs à 10000
-les montants sont entre 4000 et 10000
-les montants sont inférieurs à 10000
ces sous totaux seront mis dans une ligne qui sera insérée en dessous de la dernière ligne de chaque condition
Jusque là cava, g réussi à bidouiller des trucs. Mais mon problème se pose lorsque je supprime une ligne.
mon sous total ne bouge pas. g essayé de mettre du .formula à la place de .value, mais cest pas terrible.
désesperée, je viens chercher de l'aide. si quelqu'un a une solution
merci

Sub TrierEtSommeSItest()

Worksheets("Feuil1").Range("A1").Sort Key1:=Worksheets("Feuil1").Columns("H"), order1:=xlDescending, Header:=xlGuess

' boucle
For i = 2 To 10000
    If Range("H" & i).Value >= 10000 Then
        SommeSup = SommeSup + Range("H" & i).Value
        derniersup = i
        vadresse = Worksheets(1).Range("H" & i).Address
    ElseIf Range("H" & i).Value >= 4000 And Range("H" & i).Value < 10000 Then
        SommeInf = SommeInf + Range("H" & i).Value
        dernierinf = i
    Else
        SommeReste = SommeReste + Range("H" & i).Value
    End If
Next

Range("H" & derniersup + 1).EntireRow.Insert
Range("G" & derniersup + 1).Value = "Total des retards >= 10 000"
Range("G" & derniersup + 1).Font.Bold = True
Range("G" & derniersup + 1).HorizontalAlignment = xlRight
Range("H" & derniersup + 1).Value = SommeSup
'ligne suivante :test : copier la formule afin que si ya supression de ligne, le sous total puisse changer automatiquement
'Range("H" & derniersup + 1).Formula = "=SUM(" & vadresse & " )"
Range("H" & derniersup + 1).Font.Bold = True

Range("H" & dernierinf + 2).EntireRow.Insert
Range("G" & dernierinf + 2).Value = "Total des retards entre 4 000 et 10 000"
Range("G" & dernierinf + 2).Font.Bold = True
Range("G" & dernierinf + 2).HorizontalAlignment = xlRight
Range("H" & dernierinf + 2).Value = SommeInf
Range("H" & dernierinf + 2).Font.Bold = True

Cells(Rows.Count, 7).End(xlUp).Offset(1).Select
Cells(Rows.Count, 7).End(xlUp).Offset(1).Value = "Total des retards < 4000"
Cells(Rows.Count, 7).End(xlUp).Font.Bold = True
Cells(Rows.Count, 7).End(xlUp).Offset(1).HorizontalAlignment = xlRight
Cells(Rows.Count, 8).End(xlUp).Offset(1).Value = SommeReste
Cells(Rows.Count, 8).End(xlUp).Font.Bold = True

End Sub

 

[Hippolite]

Re : si ligne supprimée, le sous total ne bouge pas?!

Bonjour,
Pour que le calcul se réactualise automatiquement, il faut qu'il soit fait dans une fonction personnalisée qui contient Application.Volatile
A+

 

[Pierrot93]

Re : si ligne supprimée, le sous total ne bouge pas?!

Bonjour,

essaye ceci, à placer avant le "end sub" :

Sheets("NomFeuille").Calculate

bon après midi
@+

 

[fopynem]

Re : si ligne supprimée, le sous total ne bouge pas?!

Bonjour,

essaye ceci, à placer avant le "end sub" :

Sheets("NomFeuille").Calculate

bon après midi
@+

re,
ça ne marche pas

 

[Pierrot93]

Re : si ligne supprimée, le sous total ne bouge pas?!

Re,

sans plus de détails, pas d'autre idée....

 

[Hippolite]

Re : si ligne supprimée, le sous total ne bouge pas?!

Re,
On peut essayer de lancer Sub TrierEtSommeSItest() avec Private Sub Worksheet_Change(ByVal Target As Range), mais c'est de la grosse artillerie.
Il faudrait avoir un fichier avec le code pour voir ce qui peut être fait.
A+

 

[fopynem]

Re : si ligne supprimée, le sous total ne bouge pas?!

Re,

sans plus de détails, pas d'autre idée....

voici le fichier joint :

 

[Hippolite]

Re : si ligne supprimée, le sous total ne bouge pas?!

Re,
Je pense que la façon la plus propre serait d'utiliser les sous-totaux automatiques.
Je n'ai pas excel sous la main, je regarderai demain.

Sinon une autre façon de procéder serait de calculer des formules (qui s'ajusteront en cas de suppression de lignes)
Très rapidement, ça donnerait (non testé, fait de tête) quelque chose comme
(les lignes non reprises ont été mises en commentaires)

Sub TrierEtSommeSI()
Worksheets("Feuil1").Range("A1").Sort Key1:=Worksheets("Feuil1").Columns("H"), order1:=xlDescending, Header:=xlGuess

' boucle
Dlign = Cells(Rows.Count, 1).End(xlUp).Row 'dernière ligne
For i = 2 To Dlign ' peut être allégé par une simple recherche des deux seuils
    If Range("H" & i).Value >= 10000 Then
'        SommeSup = SommeSup + Range("H" & i).Value
       derniersup = i
    ElseIf Range("H" & i).Value >= 4000 And Range("H" & i).Value < 10000 Then
'        SommeInf = SommeInf + Range("H" & i).Value
       dernierinf = i
    Else
'        SommeReste = SommeReste + Range("H" & i).Value
   End If
Next i

Range("H" & derniersup + 1).EntireRow.Insert
Range("G" & derniersup + 1).Value = "Total des retards >= 10 000"
Range("G" & derniersup + 1).Font.Bold = True
Range("G" & derniersup + 1).HorizontalAlignment = xlRight
'Range("H" & derniersup + 1).Value = SommeSup
Range("H" & derniersup + 1).Formula = "= SUM(H2:H" & derniersup & ")"
Range("H" & derniersup + 1).Font.Bold = True

Range("H" & dernierinf + 2).EntireRow.Insert
Range("G" & dernierinf + 2).Value = "Total des retards entre 4 000 et 10 000"
Range("G" & dernierinf + 2).Font.Bold = True
Range("G" & dernierinf + 2).HorizontalAlignment = xlRight
'Range("H" & dernierinf + 2).Value = SommeInf
Range("H" & dernierinf + 2).Formula = "= SUM(H" & derniersup + 2 & ":H" & dernierinf + 1 & ")"
Range("H" & dernierinf + 2).Font.Bold = True

' me permets d'accéder à la dernière cellule non vide
Dlign = Dlign + 3
Cells(Dlign, 7).Select
Cells(Dlign, 7).Value = "Total des retards < 4000"
Cells(Dlign, 7).Font.Bold = True
Cells(Dlign, 7).HorizontalAlignment = xlRight
'Cells(Rows.Count, 8).End(xlUp).Offset(1).Value = SommeReste
Cells(Dlign, 8).Formula = "= SUM(H" & dernierinf + 3 & ":H" & Dlign - 1 & ")"
Cells(Dlign, 8).Font.Bold = True

End Sub

A+

 

[fopynem]

Re : si ligne supprimée, le sous total ne bouge pas?!

Merci Hyppolite, je suis e train de bosser dessus, mais juste une petite question
sur cette ligne :

Range("H" & derniersup + 1).Formula = "= somme(H2:H"& derniersup

ne manque t'il pas un & ou une parenthese ?
car excel me souligne cette ligne comme erreur

 

[Hippolite]

Re : si ligne supprimée, le sous total ne bouge pas?!

Re,
J'ai retoiletté, il y avait 2 autres erreurs en plus des trois parenthèses non refermées :
Dlign = Dlign + 3 , et Dlign - 1 à la dernière formule.
Désolé pour ces coquilles, je n'ai pas les moyens de valider.
A+

 

[fopynem]

Re : si ligne supprimée, le sous total ne bouge pas?!

ui j'avais vu merci. mais ca ne fonctionne toujours pas. je suis en trai de le bidouiller :d

 

[Hippolite]

Re : si ligne supprimée, le sous total ne bouge pas?!

Bonjour,
C'est corrigé
A+