Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

Calculs sous totaux par macro

Créer une discussion
  • Initiateur de la discussion Initiateur de la discussion kheldar
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

S'inscrire
K

kheldar

Guest
Bonjour à tous,

Je vous expose mon problème: sur un tableau qui fait plusieurs milliers de lignes, je souhaiterai regrouper ( sommer en fait) plusieurs lignes pour en faire un sous total mais cette action doit être effectuée sur un grand nombre de regroupements.

Ci-joint un fichier exemple vous permettant de comprendre mon besoin.
Je précise que je souhaite lancer ces calculs par macro vu le grand nombre de sous totaux à calculer. L'ordre et les valeurs des cellules de données ( lignes fournisseurs) ne doivent pas être modifiées.

Merci d'avance pour vos réponses ( une macro ) en espérant avoir été assez clair dans ma demande.

Cordialement.
 

Pièces jointes

Trier par date Trier par votes
Re : Calculs sous totaux par macro

Merci JGJL,

Mais cela ne répond pas à mes besoins exactement comme je le souhaiterai.

Je réitère donc ma demande.

Merci encore.

Cordialement.
 
Vote positif 0 Vote négatif
Re : Calculs sous totaux par macro

Bonjour kheldar, JCGL, le forum,

Avec cette macro et le fichier :

Code: 
Sub SousTotal()
Dim cel As Range, ref As Range
For Each cel In Range("B6:B" & Range("B65536").End(xlUp).Row)
If InStr(cel, "SOUS TOTAL") Then
Set ref = Range("B:B").Find(What:="SOUS TOTAl", After:=cel, LookIn:=xlValues, LookAt:=xlPart)
If ref.Row <= cel.Row Then Set ref = Range("B65536").End(xlUp)(2)
cel.Offset(, 1) = Application.Sum(Range(cel, ref.Offset(-1)).Offset(, 1))
cel.Offset(, 2) = Application.Sum(Range(cel, ref.Offset(-1)).Offset(, 2))
Set cel = ref
End If
Next
End Sub

Edit : j'avais mis < au lieu de <= (il pourrait y avoir un seul SOUS TOTAL)

A+
 

Pièces jointes

Dernière édition:
Vote positif 0 Vote négatif
Re : Calculs sous totaux par macro

Re,

Une autre manière de faire, probablement un peu plus rapide :

Code: 
Sub SousTotal()
Dim cel As Range, ref As Range, fin As Boolean
Set cel = Range("B:B").Find(What:="SOUS TOTAl", LookIn:=xlValues, LookAt:=xlPart)
If cel Is Nothing Then Exit Sub
1 Set ref = Range("B:B").Find("SOUS TOTAl", After:=cel)
If ref.Row <= cel.Row Then Set ref = Range("B65536").End(xlUp)(2): fin = True
cel.Offset(, 1) = Application.Sum(Range(cel, ref.Offset(-1)).Offset(, 1))
cel.Offset(, 2) = Application.Sum(Range(cel, ref.Offset(-1)).Offset(, 2))
If fin Then Exit Sub
Set cel = ref
GoTo 1
End Sub

A+
 
Vote positif 0 Vote négatif
Re : Calculs sous totaux par macro

Bonjour à tous,

Puis-je me permettre ce complément pour éviter le cumul avec les valeurs précédentes ?

Code: 
Option Explicit

Sub SousTotal() ' d'après Job75 sur XLD
Dim Cel As Range, Ref As Range, Fin As Boolean
Set Cel = Range("B:B").Find(What:="SOUS TOTAL", LookIn:=xlValues, LookAt:=xlPart)
If Cel Is Nothing Then Exit Sub
1 Set Ref = Range("B:B").Find("SOUS TOTAl", After:=Cel)
If Ref.Row <= Cel.Row Then Set Ref = Range("B65536").End(xlUp)(2): Fin = True
Cel.Offset(, 1).ClearContents
Cel.Offset(, 1) = Application.Sum(Range(Cel, Ref.Offset(-1)).Offset(, 1))
Cel.Offset(, 2).ClearContents
Cel.Offset(, 2) = Application.Sum(Range(Cel, Ref.Offset(-1)).Offset(, 2))
If Fin Then Exit Sub
Set Cel = Ref
GoTo 1
End Sub

A+ à tous
 
Vote positif 0 Vote négatif
Re : Calculs sous totaux par macro

Re,

Merci JCGL, j'avais oublié d'appuyer 2 fois sur le bouton... Travail d'équipe 🙂

Mais il y a plus simple, car je ne faisais pas les bonnes sommes :

Code: 
Sub SousTotal()
Dim cel As Range, ref As Range, fin As Boolean
Set cel = Range("B:B").Find(What:="SOUS TOTAl", LookIn:=xlValues, LookAt:=xlPart)
If cel Is Nothing Then Exit Sub
1 Set ref = Range("B:B").Find("SOUS TOTAl", After:=cel)
If ref.Row <= cel.Row Then Set ref = Range("B65536").End(xlUp)(2): fin = True
cel.Offset(, 1) = Application.Sum(Range(cel.[COLOR="Red"]Offset(1) [/COLOR],ref.Offset(-1)).Offset(, 1))
cel.Offset(, 2) = Application.Sum(Range(cel.[COLOR="Red"]Offset(1) [/COLOR],ref.Offset(-1)).Offset(, 2))
If fin Then Exit Sub
Set cel = ref
GoTo 1
End Sub

Edit : bon évidemment, si entre 2 SOUS TOTAL il n'y a pas de lignes... Utiliser alors la macro corrigée par JCGL

A+
 

Pièces jointes

Dernière édition:
Vote positif 0 Vote négatif
Re : Calculs sous totaux par macro

Re,

Finalement une macro qui fonctionne dans tous les cas de figure, on y arrive 😱

Code: 
Sub SousTotal()
Dim cel As Range, ref As Range, fin As Boolean
Set cel = Range("B:B").Find(What:="SOUS TOTAl", LookIn:=xlValues, LookAt:=xlPart)
If cel Is Nothing Then Exit Sub
1 Set ref = Range("B:B").Find("SOUS TOTAl", After:=cel)
If ref.Row <= cel.Row Then Set ref = Range("B65536").End(xlUp)(2): fin = True
cel.Offset(, 1) = Application.Sum(Range(cel, ref.Offset(-1)).Offset(, 1)) [COLOR="Red"]- cel.Offset(, 1)[/COLOR]
cel.Offset(, 2) = Application.Sum(Range(cel, ref.Offset(-1)).Offset(, 2)) [COLOR="Red"]- cel.Offset(, 2)[/COLOR]
If fin Then Exit Sub
Set cel = ref
GoTo 1
End Sub

Note : j'ai relooké le fichier par copier-coller (nombre de Ko)

A+
 

Pièces jointes

Vote positif 0 Vote négatif
Re : Calculs sous totaux par macro

Bonjour à tous,

Merci à job75 et à JGCL pour leurs réponses.

Ca y est presque.


En effet, si entre 2 SOUS TOTAL il n'y a pas de lignes, eh bien sur ces lignes, la macro ne met des 0 à la place des valeurs.

Merci beaucoup pour toutes vos réponses, à part le petit problème ci-dessus, cela fonctionne parfaitement.

Débloquer moi ce problème, svp.
Je n'y arrive pas même en décortiquant la macro présentée par job75 et en l'améliorant avec celle de JGCL

Merci à vous.

Cordialement.
 
Vote positif 0 Vote négatif
Re : Calculs sous totaux par macro

Bonjour à tous,

Peux-tu essayer avec ce code :

Code: 
Option Explicit
Sub SousTotal()
Dim cel As Range, ref As Range, fin As Boolean
Set cel = Range("B:B").Find(What:="SOUS TOTAL", LookIn:=xlValues, LookAt:=xlPart)
If cel Is Nothing Then Exit Sub
1 Set ref = Range("B:B").Find("SOUS TOTAL", After:=cel)
If ref.Row <= cel.Row Then Set ref = Range("B65536").End(xlUp)(2): fin = True
cel.Offset(, 1) = Format(Application.Sum(Range(cel, ref.Offset(-1)).Offset(, 1)) - cel.Offset(, 1), "###0.00")
cel.Offset(, 2) = Format(Application.Sum(Range(cel, ref.Offset(-1)).Offset(, 2)) - cel.Offset(, 2), ".000%;;")
If fin Then Exit Sub
Set cel = ref
GoTo 1
End Sub

A+ à tous
 
Vote positif 0 Vote négatif
Re : Calculs sous totaux par macro

Bonjour JCGL,

Je viens d'essayer ton code, et malheureusement, cela ne résout pas le problème.

Le soucis vient du fait que si il n'y a pas de lignes à additionner en dessous de la ligne SOUS TOTAL, la macro n'arrive pas à passer au-dessus du reste du calcul.

Argghhhh, juste cela qui bloque mon analyse; je n'arrive vraiment pas à trouver le test qui fait que si la ligne inférieure est également SOUS TOTAL, alors la macro doit passer au SOUS TOTAL suivant sans changer les valeurs de cette ligne SOUS TOTAL seule.

J'espère pouvoir trouver ou obtenir ( grâce au forum ) une solution.

Merci d'avance pour tout.

Cordialement.
 
Vote positif 0 Vote négatif
Re : Calculs sous totaux par macro

Bonjour kheldar, JCGL,

Fallait préciser peut-être avant, non ?

Alors avec juste un petit test supplémentaire :

Code: 
Sub SousTotal()
Dim cel As Range, ref As Range, fin As Boolean
Set cel = Range("B:B").Find(What:="SOUS TOTAL", LookIn:=xlValues, LookAt:=xlPart)
If cel Is Nothing Then Exit Sub
1 Set ref = Range("B:B").Find("SOUS TOTAL", After:=cel)
If ref.Row <= cel.Row Then Set ref = Range("B65536").End(xlUp)(2): fin = True
[COLOR="Red"]If ref.Row > cel.Row + 1 Then[/COLOR]
cel.Offset(, 1) = Application.Sum(Range(cel.Offset(1) ,ref.Offset(-1)).Offset(, 1))
cel.Offset(, 2) = Application.Sum(Range(cel.Offset(1) ,ref.Offset(-1)).Offset(, 2))
[COLOR="Red"]End If[/COLOR]
If fin Then Exit Sub
Set cel = ref
GoTo 1
End Sub

A+
 
Dernière édition:
Vote positif 0 Vote négatif
Re : Calculs sous totaux par macro

Bonjour job75

Je viens de lancer le test et cela fonctionne parfaitement comme je le souhaite.

Je vous remercie beaucoup Messieurs ( job75 et JCGL), grâce à vous je vais gagner à peu près 20 heures de traitement fastidieux qui maintenant en un clic me donne les calculs ( et bien évidemment les résultats ) attendus.

Encore merci , et je peux vous aider dans la mesure de mes possiblités, j'en serai ravi.

Cordialement.
 
Vote positif 0 Vote négatif
Identifiez-vous ou inscrivez-vous pour participer.
Rejoins nos membres "Supporter XLD" et booste ton expérience Excel !
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD
Assurez vous de marquer un message comme solution pour une meilleure transparence.

Discussions similaires

S
  • Question Question
Autres Macro sous conditions
Réponses
3
Affichages
657
scorpileo
S
Y
  • Question Question
Microsoft 365 Macro Somme.Si.Ens
Réponses
9
Affichages
919
youssefcha
Y
S
  • Question Question
XL 2016 Problème de classement de prix croissants non désiré
Réponses
4
Affichages
848
chris
  • Question Question
XL 2010 Calcul de sous-totaux par le haut d'une liste de données
Réponses
3
Affichages
855
cp4
B
  • Question Question
XL 2016 Doublons - Remonter sur une seule ligne en créant de nouvelles colonnes
Réponses
9
Affichages
898
Benskyy
B
K
  • Question Question
Google Sheets Aide pour l'élaboration d'une macro sous google sheet
Réponses
2
Affichages
1 K
Kiritora
K
S
  • Question Question
XL 2010 VBA - macro avec 1 boucle qui alterne 1 action à conditions et 1 action sans conditions
2 3 4
Réponses
58
Affichages
9 K
Scorp0211
S
C
  • Résolu(e)
XL 2016 Remplir automatiquement un tableau d'après des conditions et des valeurs
Réponses
11
Affichages
2 K
ERIC S
S
  • Question Question
Autres Lourdeur du fichier excel et lenteur du traitement macro : comment identifier les éléments générant ces lenteurs et lourdeurs et comment optimiser ?
Réponses
9
Affichages
5 K
TooFatBoy
D
  • Question Question
XL 2010 Arrêt de copier à la dernière ligne.
Réponses
2
Affichages
1 K
job75
N
  • Résolu(e)
XL pour MAC Refonte complete d'un fichier, besoin d'idées
8 9 10
Réponses
147
Affichages
14 K
Staple1600
B
  • Question Question
Comment combiner de nombreux fichiers et tableaux
Réponses
10
Affichages
2 K
Bastien43
B
C
  • Question Question
XL 2019 Macro si texte présent plusieurs fois alors insérer une ligne total au dessus
Réponses
8
Affichages
1 K
plv23
P
A
  • Question Question
XL 2010 dessiner avec VBA sous excel 2010
2
Réponses
24
Affichages
6 K
artlight
A
H
  • Question Question
Autres A l'attention de vgendron: améliorer le fonctionnement d'un Tableau excel Exposants réalisé par vgendron
Réponses
2
Affichages
891
Hyriu29
H
G
  • Question Question
XL 2013 Obtenir une facture par NOM par rapport à tableau de présence
Réponses
4
Affichages
1 K
gaelletreg
G
A
  • Question Question
XL 2010 Utilisation de formules dans un tableau ou tableau croisé dynamique ?
Réponses
0
Affichages
925
ajless
A
  • Question Question
Sous-Total en fonction de fin de ligne variable
Réponses
1
Affichages
1 K
Lone-wolf
N
  • Question Question
reporter automatiquement sur un planning de production
Réponses
4
Affichages
2 K
neim
N
K
  • Question Question
Macro copier coller valeurs n lignes
Réponses
4
Affichages
2 K
KL2EM
K
Menu
Connexion
S'inscrire
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…