Somme automatique dans une macro

Version imprimable

21/07/2012, 17h00
willabe

Somme automatique dans une macro

Bonjour,

Je recherche à faire une macro qui m'additionne les cellules colonne B et m'insere la somme dans la cellule vide "somme". Le nombre de ligne peut être variable
exemple :
A B
titi 10
titi 10
titi 10
somme
toto 10
toto 10
somme
tata 20
tata 20
somme
:cry:

Pourquoi tu ne supprime pas les lignes où est inscrit somme et tu appliques l'outil d'Excel Sous-total.

XL 2007 et plus > Onglet Données.

Ps. il faut au préalable trier les données par rapport à la colonne 1.

Pourquoi recréer la roue?

Exemple par macro:

Données dans Feuil1 colonnes A et B avec la ligne 1 celle des titres
Code:

1 2 3 4 5 6 7 8 9 10 Sub MacroSousTotal() Dim LastLig As Long Application.ScreenUpdating = False With Worksheets("Feuil1") 'à adapter .UsedRange.RemoveSubtotal LastLig = .Cells(.Rows.Count, "A").End(xlUp).Row .Range("A1").Resize(LastLig, 2).Subtotal GroupBy:=1, Function:=xlSum, TotalList:=Array(2) End With End Sub

21/07/2012, 17h35
willabe

reponse

denomination quantité poids
Aiguillette France 1 0 0
Aiguillettes Declasse 1 0
Aiguillettes Saisie 1 0 0
somme de B et de c
Arriere de Canard France 1 0

Canard Entier France 1 0

Canard Sans Foie France 1 0

Carcasse Canard France 1 0

Coeur Canard France 1 0
21/07/2012, 17h46
mercatog

Et ceci veut dire quoi?
C'est encourageant comme intervention.
21/07/2012, 19h58
papouclo

Bonjour,
Pour montrer que l'on peut s'en sortir sans macro, copier dans C5 la formule

Code:

=SOMME(C$2:C4)-2*SOMME.SI(B$2:B4;"somme";C$2:C4)

Recopier en D5 et dans toutes les cellules des colonnes C: D où l'on veut un calcul de somme.
Mais bon! il n'y avait que 42 lignes. Dans un fichier ayant un nombre conséquent de lignes, il vaut sans doute mieux se tourner vers le VBA.
Cordialement
Claude
21/07/2012, 20h30
Supermichou

Il existe même une fonction pour ça !!

en C5

Code:

=SOUS.TOTAL(9;C2:C4)

en C43

Code:

=SOUS.TOTAL(9;C2:C42)

le 9, c'est pour dire de faire la somme.
sous.total fait la somme des nombres en excluant de prendre les autres sous totaux.

il est donc possible de ne pas faire de somme pour les lignes à 1 en quantité.

Ah Ah j'avais pas vu l'autre post de mercatoq !!!
Mercatoq copyright sur sous.total alors :)
22/07/2012, 11h35
78chris

Bonjour

Et on est sensé additionner quoi ?

Illustre ton exemple avec la formule attendue sur 3 ou 4 cas...

Edit : inutile d'ouvrir 2 fils (je viens de découvrir le 1er)

Je répète la question : on additionne depuis le début (somme cumulée) ou bien c'est un sous-total ? La précision est essentielle.
22/07/2012, 12h47
willabe

info sur ma demande

Bonjour :
Je ne me suis pas bien fait comprendre. Je veux une macro qui me fasse une somme des données jusqu'à la cellule vide. C'est déja une macro qui me permet de trier par ordre alaphabétique et d'insérer une ligne pour faire les totaux .Maintenant je veux ajouter à celle ci la somme des données de chaque famille triée
22/07/2012, 21h30
SfJ5Rpw8

bonsoir,

poste ton code entre balises [code][/code] (bouton http://www.developpez.net/forums/images/editor/code.gif ) histoire de voir comment tu tries et insères ces lignes....

Bonjour voici ma macro

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
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
'rennome le feuille
On Error GoTo msg
ActiveSheet.Name = Range("A1")
Range("B2").Select
'tri de a a z
 
Range("B2:D55").Select
    ActiveWorkbook.Worksheets("Lot").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Lot").Sort.SortFields.Add Key:=Range("B2"), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Lot").Sort
        .SetRange Range("B2:D100")
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Range("B2").Select
 
    'modif largeur colonne
 
Columns("B:B").ColumnWidth = 29.14
    Range("B1").Select
    'recherche texte
 
   Set fc = Worksheets("Lot").Columns("b").Find(What:="Aiguillettes Saisie")
If fc Is Nothing Then MsgBox " Pas de mot Aiguillettes Saisie trouvé dans la colonne b" Else
fc.Select
'decalage 1 en bas
ActiveCell.Offset(1, 0).Select
'insertion ligne
Selection.EntireRow.Insert
ActiveCell.FormulaR1C1 = "SOMME"
 
   'recherche texte
   Set fc = Worksheets("Lot").Columns("b").Find(What:="Arr")
If fc Is Nothing Then MsgBox " Pas de mot TOTO trouvé dans la colonne b" Else
fc.Select
'decalage 1 en bas
ActiveCell.Offset(1, 0).Select
'insertion ligne
Selection.EntireRow.Insert
ActiveCell.FormulaR1C1 = "SOMME"
Set fc = Worksheets("Lot").Columns("B").Find(What:="Canard Entier")
If fc Is Nothing Then MsgBox " Pas de mot TOTO trouvé dans la colonne b" Else
fc.Select
'decalage 1 en bas
ActiveCell.Offset(1, 0).Select
'insertion ligne
Selection.EntireRow.Insert
Set fc = Worksheets("Lot").Columns("B").Find(What:="Canard Sans Foie")
If fc Is Nothing Then MsgBox " Pas de mot  TOTOtrouvé dans la colonne b":
fc.Select
'decalage 1 en bas
ActiveCell.Offset(1, 0).Select
'insertion ligne
 
Selection.EntireRow.Insert
Set fc = Worksheets("Lot").Columns("B").Find(What:="Carcasse")
If fc Is Nothing Then MsgBox " Pas de mot TOTO trouvé dans la colonne b" Else
fc.Select
'decalage 1 en bas
ActiveCell.Offset(1, 0).Select
'insertion ligne
Selection.EntireRow.Insert
Set fc = Worksheets("Lot").Columns("B").Find(What:="Coeur")
If fc Is Nothing Then MsgBox " Pas de mot TOTO trouvé dans la colonne b" Else
fc.Select
'decalage 1 en bas
ActiveCell.Offset(1, 0).Select
'insertion ligne
Selection.EntireRow.Insert
 
Set fc = Worksheets("Lot").Columns("B").Find(What:="Cuisses Canard Saisie")
If fc Is Nothing Then MsgBox " Pas de mot TOTO trouvé dans la colonne b" Else
fc.Select
'decalage 1 en bas
ActiveCell.Offset(1, 0).Select
'insertion ligne
Selection.EntireRow.Insert
 
Set fc = Worksheets("Lot").Columns("B").Find(What:="Foie TV")
If fc Is Nothing Then MsgBox " Pas de mot TOTO trouvé dans la colonne b" Else
fc.Select
'decalage 1 en bas
ActiveCell.Offset(1, 0).Select
'insertion ligne
Selection.EntireRow.Insert
 
Set fc = Worksheets("Lot").Columns("B").Find(What:="Foies Saisie")
If fc Is Nothing Then MsgBox " Pas de mot  TOTOtrouvé dans la colonne b":
fc.Select
'decalage 1 en bas
ActiveCell.Offset(1, 0).Select
'insertion ligne
Selection.EntireRow.Insert
Set fc = Worksheets("Lot").Columns("B").Find(What:="Gesier")
If fc Is Nothing Then MsgBox " Pas de mot TOTO trouvé dans la colonne b" Else
fc.Select
'decalage 1 en bas
ActiveCell.Offset(1, 0).Select
'insertion ligne
Selection.EntireRow.Insert
 
Set fc = Worksheets("Lot").Columns("B").Find(What:="MagretS SAISIE")
If fc Is Nothing Then MsgBox " Pas de mot  TOTOtrouvé dans la colonne b" Else
fc.Select
'decalage 1 en bas
ActiveCell.Offset(1, 0).Select
'insertion ligne
Selection.EntireRow.Insert
 
Set fc = Worksheets("Lot").Columns("B").Find(What:="Manchons Saisie")
If fc Is Nothing Then MsgBox " Pas de mot  TOTOtrouvé dans la colonne b" Else
fc.Select
'decalage 1 en bas
ActiveCell.Offset(1, 0).Select
'insertion ligne
Selection.EntireRow.Insert
Set fc = Worksheets("Lot").Columns("B").Find(What:="Parure")
If fc Is Nothing Then MsgBox " Pas de mot  TOTOtrouvé dans la colonne b" Else
fc.Select
'decalage 1 en bas
ActiveCell.Offset(1, 0).Select
'insertion ligne
Selection.EntireRow.Insert
 
Set fc = Worksheets("Lot").Columns("B").Find(What:="Parures Saisie")
If fc Is Nothing Then MsgBox " Pas de mot  TOTOtrouvé dans la colonne b" Else
fc.Select
'decalage 1 en bas
ActiveCell.Offset(1, 0).Select
'insertion ligne
Selection.EntireRow.Insert
 
Set fc = Worksheets("Lot").Columns("B").Find(What:="Patelot")
If fc Is Nothing Then MsgBox " Pas de mot  TOTOtrouvé dans la colonne b" Else
fc.Select
'decalage 1 en bas
ActiveCell.Offset(1, 0).Select
'insertion ligne
Selection.EntireRow.Insert
 
Exit Sub
msg: MsgBox "la feuille ne peut pas être renommée"
 Range("B2").Select
 
End Sub