Sous-totaux

Bonjour Izmi,

Il y a aussi ceci :

Cependant, je ne suis pas sûr que la fonction "xlSum" soit la plus appropriée.

'-------------------------
Sub Sous_Totaux()

With Worksheets("Feuil1")
Set Rg = .Range("A1:A" & .Range("A65536").End(xlUp).Row)
End With
With Rg
.Insert Shift:=xlToRight
.Item(1, 1).Offset(, -1) = "Année"
.Offset(1, -1).Resize(Rg.Rows.Count - 1).FormulaLocal = _
"=année(" & Rg.Parent.Name & "!" & Rg(Rg.Offset(1).Row).Address(0, 0) & ")"
.Offset(, -1).Subtotal GroupBy:=1, Function:=xlSum, TotalList:=Array(1), _
Replace:=True, PageBreaks:úlse, SummaryBelowData:=True
End With

End Sub
'-------------------------


Salutations!



"Izmi" <Izmi@discussions.microsoft.com> a écrit dans le message de news: 4F97CA4F-2D8E-401D-A0BC-A029518ED0AE@microsoft.com...
Bonjour ;

Sous réserve de confirmation par nos chers experts, je crois avoir réussi à
faire des sous-totaux par année pour une liste de jours.
Comment ?
En mettant bout à bout deux idées que MichDenis m'a soufflé (post du
14/10/O5 et d'aujourd'hui.) et en maniant l'enregistreur de macro.

En procédant ainsi je n'est peut être pas fait quelque chose de fini. Les
experts pourront peut être affiner.

Sub Macro1()
'
' Macro1 Macro
' Macro enregistrée le 16/10/2005 par Izmi
'

'
Columns("A:A").Select
Selection.Insert Shift:=xlToRight
Range("A2").Select
ActiveCell.FormulaR1C1 = "=YEAR(RC[1])"
Range("A2").Select
Selection.AutoFill Destination:=Range("A2:A30")
Range("A2:A30").Select
Range("B2").Select
Selection.Subtotal GroupBy:=1, Function:=xlSum, TotalList:=Array(3), _
Replace:=True, PageBreaks:úlse, SummaryBelowData:=True
Test
End Sub

Sub Test()
Dim Rg As Range
With Worksheets("Feuil1")
Set Rg = .Range("A1:A" & .Range("A65536").End(xlUp).Row)
End With
For Each c In Rg
If c.Characters.Font.Bold = True Then
c.Offset(, 1) = c
c.Offset(, 1).Characters.Font.Bold = True
End If
Next
Rg.EntireColumn.Delete xlToLeft
Set Rg = Nothing
End Sub

Le code final obtenu et semble bien marcher est le suivant :

Encore un petit effort Michdenis :)
Ce n'est pas tout à fait au point. Mais là tu t'endoutais déjà.
Mon bric à brac répond mieux à ce que je souhaite, sauf que, malheureusement
il n'est pas adapté aux grands tableaux. Je viens d'en faire un test.
Merci encore

Bonjour Izmi,

Il y a aussi ceci :

Cependant, je ne suis pas sûr que la fonction "xlSum" soit la plus appropriée.

'-------------------------
Sub Sous_Totaux()

With Worksheets("Feuil1")
Set Rg = .Range("A1:A" & .Range("A65536").End(xlUp).Row)
End With
With Rg
.Insert Shift:=xlToRight
.Item(1, 1).Offset(, -1) = "Année"
.Offset(1, -1).Resize(Rg.Rows.Count - 1).FormulaLocal = _
"=année(" & Rg.Parent.Name & "!" & Rg(Rg.Offset(1).Row).Address(0, 0) & ")"
.Offset(, -1).Subtotal GroupBy:=1, Function:=xlSum, TotalList:=Array(1), _
Replace:=True, PageBreaks:úlse, SummaryBelowData:=True
End With

End Sub
'-------------------------


Salutations!



"Izmi" <Izmi@discussions.microsoft.com> a écrit dans le message de news: 4F97CA4F-2D8E-401D-A0BC-A029518ED0AE@microsoft.com...
Bonjour ;

Sous réserve de confirmation par nos chers experts, je crois avoir réussi à
faire des sous-totaux par année pour une liste de jours.
Comment ?
En mettant bout à bout deux idées que MichDenis m'a soufflé (post du
14/10/O5 et d'aujourd'hui.) et en maniant l'enregistreur de macro.

En procédant ainsi je n'est peut être pas fait quelque chose de fini. Les
experts pourront peut être affiner.

Sub Macro1()
'
' Macro1 Macro
' Macro enregistrée le 16/10/2005 par Izmi
'

'
Columns("A:A").Select
Selection.Insert Shift:=xlToRight
Range("A2").Select
ActiveCell.FormulaR1C1 = "=YEAR(RC[1])"
Range("A2").Select
Selection.AutoFill Destination:=Range("A2:A30")
Range("A2:A30").Select
Range("B2").Select
Selection.Subtotal GroupBy:=1, Function:=xlSum, TotalList:=Array(3), _
Replace:=True, PageBreaks:úlse, SummaryBelowData:=True
Test
End Sub

Sub Test()
Dim Rg As Range
With Worksheets("Feuil1")
Set Rg = .Range("A1:A" & .Range("A65536").End(xlUp).Row)
End With
For Each c In Rg
If c.Characters.Font.Bold = True Then
c.Offset(, 1) = c
c.Offset(, 1).Characters.Font.Bold = True
End If
Next
Rg.EntireColumn.Delete xlToLeft
Set Rg = Nothing
End Sub

Le code final obtenu et semble bien marcher est le suivant :

Et si tu donnais des précisions sur ce qui ne va pas ...


Salutations!


"Izmi" <Izmi@discussions.microsoft.com> a écrit dans le message de news: BED5B345-8B47-4833-BC88-70259124625B@microsoft.com...
Encore un petit effort Michdenis :)
Ce n'est pas tout à fait au point. Mais là tu t'endoutais déjà.
Mon bric à brac répond mieux à ce que je souhaite, sauf que, malheureusement
il n'est pas adapté aux grands tableaux. Je viens d'en faire un test.
Merci encore

Bonjour Izmi,

Il y a aussi ceci :

Cependant, je ne suis pas sûr que la fonction "xlSum" soit la plus appropriée.

'-------------------------
Sub Sous_Totaux()

With Worksheets("Feuil1")
Set Rg = .Range("A1:A" & .Range("A65536").End(xlUp).Row)
End With
With Rg
.Insert Shift:=xlToRight
.Item(1, 1).Offset(, -1) = "Année"
.Offset(1, -1).Resize(Rg.Rows.Count - 1).FormulaLocal = _
"=année(" & Rg.Parent.Name & "!" & Rg(Rg.Offset(1).Row).Address(0, 0) & ")"
.Offset(, -1).Subtotal GroupBy:=1, Function:=xlSum, TotalList:=Array(1), _
Replace:=True, PageBreaks:úlse, SummaryBelowData:=True
End With

End Sub
'-------------------------


Salutations!



"Izmi" <Izmi@discussions.microsoft.com> a écrit dans le message de news: 4F97CA4F-2D8E-401D-A0BC-A029518ED0AE@microsoft.com...
Bonjour ;

Sous réserve de confirmation par nos chers experts, je crois avoir réussi à
faire des sous-totaux par année pour une liste de jours.
Comment ?
En mettant bout à bout deux idées que MichDenis m'a soufflé (post du
14/10/O5 et d'aujourd'hui.) et en maniant l'enregistreur de macro.

En procédant ainsi je n'est peut être pas fait quelque chose de fini. Les
experts pourront peut être affiner.

Sub Macro1()
'
' Macro1 Macro
' Macro enregistrée le 16/10/2005 par Izmi
'

'
Columns("A:A").Select
Selection.Insert Shift:=xlToRight
Range("A2").Select
ActiveCell.FormulaR1C1 = "=YEAR(RC[1])"
Range("A2").Select
Selection.AutoFill Destination:=Range("A2:A30")
Range("A2:A30").Select
Range("B2").Select
Selection.Subtotal GroupBy:=1, Function:=xlSum, TotalList:=Array(3), _
Replace:=True, PageBreaks:úlse, SummaryBelowData:=True
Test
End Sub

Sub Test()
Dim Rg As Range
With Worksheets("Feuil1")
Set Rg = .Range("A1:A" & .Range("A65536").End(xlUp).Row)
End With
For Each c In Rg
If c.Characters.Font.Bold = True Then
c.Offset(, 1) = c
c.Offset(, 1).Characters.Font.Bold = True
End If
Next
Rg.EntireColumn.Delete xlToLeft
Set Rg = Nothing
End Sub

Le code final obtenu et semble bien marcher est le suivant :

C qui ne va pas :

1) Avec ton dernier code j'obtiens les totaux des dates et non des montants
. Mon tableau d'exemple est ainsi conçu :
A B
Dates/jour Montants
01/02/O3 127
03/02/03 210
. .
. .
12/03/O3 400
. .
. .
10/12/04 456
15/12/04 987
.
.
23/05/05
14/05/05
2) Avec mon bric à brac, ça marche très bien pour mon petit tableau
d'exemple mais pour le grand tableau seules les montants de la première année
sont additionnés. Pour les autres années pas de sous-totaux.

Salutations

Et si tu donnais des précisions sur ce qui ne va pas ...


Salutations!


"Izmi" <Izmi@discussions.microsoft.com> a écrit dans le message de news: BED5B345-8B47-4833-BC88-70259124625B@microsoft.com...
Encore un petit effort Michdenis :)
Ce n'est pas tout à fait au point. Mais là tu t'endoutais déjà.
Mon bric à brac répond mieux à ce que je souhaite, sauf que, malheureusement
il n'est pas adapté aux grands tableaux. Je viens d'en faire un test.
Merci encore

Bonjour Izmi,

Il y a aussi ceci :

Cependant, je ne suis pas sûr que la fonction "xlSum" soit la plus appropriée.

'-------------------------
Sub Sous_Totaux()

With Worksheets("Feuil1")
Set Rg = .Range("A1:A" & .Range("A65536").End(xlUp).Row)
End With
With Rg
.Insert Shift:=xlToRight
.Item(1, 1).Offset(, -1) = "Année"
.Offset(1, -1).Resize(Rg.Rows.Count - 1).FormulaLocal = _
"=année(" & Rg.Parent.Name & "!" & Rg(Rg.Offset(1).Row).Address(0, 0) & ")"
.Offset(, -1).Subtotal GroupBy:=1, Function:=xlSum, TotalList:=Array(1), _
Replace:=True, PageBreaks:úlse, SummaryBelowData:=True
End With

End Sub
'-------------------------


Salutations!



"Izmi" <Izmi@discussions.microsoft.com> a écrit dans le message de news: 4F97CA4F-2D8E-401D-A0BC-A029518ED0AE@microsoft.com...
Bonjour ;

Sous réserve de confirmation par nos chers experts, je crois avoir réussi à
faire des sous-totaux par année pour une liste de jours.
Comment ?
En mettant bout à bout deux idées que MichDenis m'a soufflé (post du
14/10/O5 et d'aujourd'hui.) et en maniant l'enregistreur de macro.

En procédant ainsi je n'est peut être pas fait quelque chose de fini. Les
experts pourront peut être affiner.

Sub Macro1()
'
' Macro1 Macro
' Macro enregistrée le 16/10/2005 par Izmi
'

'
Columns("A:A").Select
Selection.Insert Shift:=xlToRight
Range("A2").Select
ActiveCell.FormulaR1C1 = "=YEAR(RC[1])"
Range("A2").Select
Selection.AutoFill Destination:=Range("A2:A30")
Range("A2:A30").Select
Range("B2").Select
Selection.Subtotal GroupBy:=1, Function:=xlSum, TotalList:=Array(3), _
Replace:=True, PageBreaks:úlse, SummaryBelowData:=True
Test
End Sub

Sub Test()
Dim Rg As Range
With Worksheets("Feuil1")
Set Rg = .Range("A1:A" & .Range("A65536").End(xlUp).Row)
End With
For Each c In Rg
If c.Characters.Font.Bold = True Then
c.Offset(, 1) = c
c.Offset(, 1).Characters.Font.Bold = True
End If
Next
Rg.EntireColumn.Delete xlToLeft
Set Rg = Nothing
End Sub

Le code final obtenu et semble bien marcher est le suivant :

Bonjour Izmi,

Évidemment, cela dépend du tableau de départ :

Colonne A:A Les dates
Colonne B:B Les données à additionner :

'---------------------------------
Sub Sous_Totaux()

With Worksheets("Feuil1")
.Columns(1).Insert Shift:=xlToRight
Set Rg = .Range("A1:C" & .Range("B65536").End(xlUp).Row)
End With
With Rg
.Columns(1).Offset(1).Resize(Rg.Rows.Count - 1).FormulaLocal = _
"=année(" & Rg.Parent.Name & "!" & Rg(2, (Rg.Offset(1).Row)).Address(0, 0) & ")"
.Item(1, 1) = "Année"
.Subtotal GroupBy:=1, Function:=xlSum, TotalList:=Array(3), _
Replace:=True, PageBreaks:úlse, SummaryBelowData:=True
End With

End Sub
'---------------------------------


Salutations!




"Izmi" <Izmi@discussions.microsoft.com> a écrit dans le message de news: DD6F5F68-41CD-4D29-B17E-0AD9CBDF7E53@microsoft.com...
C qui ne va pas :

1) Avec ton dernier code j'obtiens les totaux des dates et non des montants
. Mon tableau d'exemple est ainsi conçu :
A B
Dates/jour Montants
01/02/O3 127
03/02/03 210
. .
. .
12/03/O3 400
. .
. .
10/12/04 456
15/12/04 987
.
.
23/05/05
14/05/05
2) Avec mon bric à brac, ça marche très bien pour mon petit tableau
d'exemple mais pour le grand tableau seules les montants de la première année
sont additionnés. Pour les autres années pas de sous-totaux.

Salutations

Et si tu donnais des précisions sur ce qui ne va pas ...


Salutations!


"Izmi" <Izmi@discussions.microsoft.com> a écrit dans le message de news: BED5B345-8B47-4833-BC88-70259124625B@microsoft.com...
Encore un petit effort Michdenis :)
Ce n'est pas tout à fait au point. Mais là tu t'endoutais déjà.
Mon bric à brac répond mieux à ce que je souhaite, sauf que, malheureusement
il n'est pas adapté aux grands tableaux. Je viens d'en faire un test.
Merci encore

Bonjour Izmi,

Il y a aussi ceci :

Cependant, je ne suis pas sûr que la fonction "xlSum" soit la plus appropriée.

'-------------------------
Sub Sous_Totaux()

With Worksheets("Feuil1")
Set Rg = .Range("A1:A" & .Range("A65536").End(xlUp).Row)
End With
With Rg
.Insert Shift:=xlToRight
.Item(1, 1).Offset(, -1) = "Année"
.Offset(1, -1).Resize(Rg.Rows.Count - 1).FormulaLocal = _
"=année(" & Rg.Parent.Name & "!" & Rg(Rg.Offset(1).Row).Address(0, 0) & ")"
.Offset(, -1).Subtotal GroupBy:=1, Function:=xlSum, TotalList:=Array(1), _
Replace:=True, PageBreaks:úlse, SummaryBelowData:=True
End With

End Sub
'-------------------------


Salutations!



"Izmi" <Izmi@discussions.microsoft.com> a écrit dans le message de news: 4F97CA4F-2D8E-401D-A0BC-A029518ED0AE@microsoft.com...
Bonjour ;

Sous réserve de confirmation par nos chers experts, je crois avoir réussi à
faire des sous-totaux par année pour une liste de jours.
Comment ?
En mettant bout à bout deux idées que MichDenis m'a soufflé (post du
14/10/O5 et d'aujourd'hui.) et en maniant l'enregistreur de macro.

En procédant ainsi je n'est peut être pas fait quelque chose de fini. Les
experts pourront peut être affiner.

Sub Macro1()
'
' Macro1 Macro
' Macro enregistrée le 16/10/2005 par Izmi
'

'
Columns("A:A").Select
Selection.Insert Shift:=xlToRight
Range("A2").Select
ActiveCell.FormulaR1C1 = "=YEAR(RC[1])"
Range("A2").Select
Selection.AutoFill Destination:=Range("A2:A30")
Range("A2:A30").Select
Range("B2").Select
Selection.Subtotal GroupBy:=1, Function:=xlSum, TotalList:=Array(3), _
Replace:=True, PageBreaks:úlse, SummaryBelowData:=True
Test
End Sub

Sub Test()
Dim Rg As Range
With Worksheets("Feuil1")
Set Rg = .Range("A1:A" & .Range("A65536").End(xlUp).Row)
End With
For Each c In Rg
If c.Characters.Font.Bold = True Then
c.Offset(, 1) = c
c.Offset(, 1).Characters.Font.Bold = True
End If
Next
Rg.EntireColumn.Delete xlToLeft
Set Rg = Nothing
End Sub

Le code final obtenu et semble bien marcher est le suivant :

Re-bonjour ;

Cette solution marche très bien pour ce que j'ai demandé. mais puisque les
experts lèvent toujours les défits (Merci Michdenis), je vais abuser.
Supposons que je doive aussi faire des sous-totaux pour C:C et D:D, comment
transformer ou compléter le code de Michdenis.

Salutations

Bonjour Izmi,

Évidemment, cela dépend du tableau de départ :

Colonne A:A Les dates
Colonne B:B Les données à additionner :

'---------------------------------
Sub Sous_Totaux()

With Worksheets("Feuil1")
.Columns(1).Insert Shift:=xlToRight
Set Rg = .Range("A1:C" & .Range("B65536").End(xlUp).Row)
End With
With Rg
.Columns(1).Offset(1).Resize(Rg.Rows.Count - 1).FormulaLocal = _
"=année(" & Rg.Parent.Name & "!" & Rg(2, (Rg.Offset(1).Row)).Address(0, 0) & ")"
.Item(1, 1) = "Année"
.Subtotal GroupBy:=1, Function:=xlSum, TotalList:=Array(3), _
Replace:=True, PageBreaks:úlse, SummaryBelowData:=True
End With

End Sub
'---------------------------------


Salutations!




"Izmi" <Izmi@discussions.microsoft.com> a écrit dans le message de news: DD6F5F68-41CD-4D29-B17E-0AD9CBDF7E53@microsoft.com...
C qui ne va pas :

1) Avec ton dernier code j'obtiens les totaux des dates et non des montants
.. Mon tableau d'exemple est ainsi conçu :
A B
Dates/jour Montants
01/02/O3 127
03/02/03 210
.. .
.. .
12/03/O3 400
.. .
.. .
10/12/04 456
15/12/04 987
..
..
23/05/05
14/05/05
2) Avec mon bric à brac, ça marche très bien pour mon petit tableau
d'exemple mais pour le grand tableau seules les montants de la première année
sont additionnés. Pour les autres années pas de sous-totaux.

Salutations

Et si tu donnais des précisions sur ce qui ne va pas ...


Salutations!


"Izmi" <Izmi@discussions.microsoft.com> a écrit dans le message de news: BED5B345-8B47-4833-BC88-70259124625B@microsoft.com...
Encore un petit effort Michdenis :)
Ce n'est pas tout à fait au point. Mais là tu t'endoutais déjà.
Mon bric à brac répond mieux à ce que je souhaite, sauf que, malheureusement
il n'est pas adapté aux grands tableaux. Je viens d'en faire un test.
Merci encore

Bonjour Izmi,

Il y a aussi ceci :

Cependant, je ne suis pas sûr que la fonction "xlSum" soit la plus appropriée.

'-------------------------
Sub Sous_Totaux()

With Worksheets("Feuil1")
Set Rg = .Range("A1:A" & .Range("A65536").End(xlUp).Row)
End With
With Rg
.Insert Shift:=xlToRight
.Item(1, 1).Offset(, -1) = "Année"
.Offset(1, -1).Resize(Rg.Rows.Count - 1).FormulaLocal = _
"=année(" & Rg.Parent.Name & "!" & Rg(Rg.Offset(1).Row).Address(0, 0) & ")"
.Offset(, -1).Subtotal GroupBy:=1, Function:=xlSum, TotalList:=Array(1), _
Replace:=True, PageBreaks:úlse, SummaryBelowData:=True
End With

End Sub
'-------------------------


Salutations!



"Izmi" <Izmi@discussions.microsoft.com> a écrit dans le message de news: 4F97CA4F-2D8E-401D-A0BC-A029518ED0AE@microsoft.com...
Bonjour ;

Sous réserve de confirmation par nos chers experts, je crois avoir réussi à
faire des sous-totaux par année pour une liste de jours.
Comment ?
En mettant bout à bout deux idées que MichDenis m'a soufflé (post du
14/10/O5 et d'aujourd'hui.) et en maniant l'enregistreur de macro.

En procédant ainsi je n'est peut être pas fait quelque chose de fini. Les
experts pourront peut être affiner.

Sub Macro1()
'
' Macro1 Macro
' Macro enregistrée le 16/10/2005 par Izmi
'

'
Columns("A:A").Select
Selection.Insert Shift:=xlToRight
Range("A2").Select
ActiveCell.FormulaR1C1 = "=YEAR(RC[1])"
Range("A2").Select
Selection.AutoFill Destination:=Range("A2:A30")
Range("A2:A30").Select
Range("B2").Select
Selection.Subtotal GroupBy:=1, Function:=xlSum, TotalList:=Array(3), _
Replace:=True, PageBreaks:úlse, SummaryBelowData:=True
Test
End Sub

Sub Test()
Dim Rg As Range
With Worksheets("Feuil1")
Set Rg = .Range("A1:A" & .Range("A65536").End(xlUp).Row)
End With
For Each c In Rg
If c.Characters.Font.Bold = True Then
c.Offset(, 1) = c
c.Offset(, 1).Characters.Font.Bold = True
End If
Next
Rg.EntireColumn.Delete xlToLeft
Set Rg = Nothing
End Sub

Le code final obtenu et semble bien marcher est le suivant :

Bonjour Izmi,

'------
Tableau de base avant d'exécuter la procédure :
Colonne 1 = Les dates
Colonne 2,3,4 des données de type numérique
'------


Voici 2 versions de la même procédure... choisis celle qui te semble la plus maléable !!!

La section intéressante est celle-ci :
.Subtotal GroupBy:=1, Function:=xlSum, TotalList:=Array(3, 4, 5),
1 = le numéro de la colonne de la plage à partir de laquelle s'effectue le regroupement

3,4,5 = Numéro de la colonne pour lesquelles seront calculés la somme à chaque changement d'années de la colonne 1


'-------------------------------
Sub Sous_Totaux()

With Worksheets("Feuil1")
.Columns(1).Insert Shift:=xlToRight
Set rg = .Range("A1:F" & .Range("B65536").End(xlUp).Row)
End With
With rg
.Columns(1).Offset(1).Resize(rg.Rows.Count - 1).FormulaLocal = _
"=année(" & rg.Parent.Name & "!" & rg(2, (rg.Offset(1).Row)).Address(0, 0) & ")"
.Item(1, 1) = "Année"
.Subtotal GroupBy:=1, Function:=xlSum, TotalList:=Array(3, 4, 5), _
Replace:=True, PageBreaks:úlse, SummaryBelowData:=True
End With

End Sub

'-------------------------------
Sub Sous_Totaux2()

With Worksheets("Feuil1")
.Columns(1).Insert Shift:=xlToRight
Set rg = .Range("A1:F" & .Range("B65536").End(xlUp).Row)
End With
With rg
.Item(1, 1) = "Année"
.Item(2, 1).FormulaLocal = "=année(" & .Item(2, 2).Address(0, 0) & ")"
Range(.Item(2, 1).Cells, .Item(rg.Rows.Count, 1).Cells).FillDown
.Subtotal GroupBy:=1, Function:=xlSum, TotalList:=Array(3, 4, 5), _
Replace:=True, PageBreaks:úlse, SummaryBelowData:=True
End With

End Sub
'-------------------------------


Salutations!





"Izmi" <Izmi@discussions.microsoft.com> a écrit dans le message de news: 7D6DB4F7-CF54-4F8D-8C2C-6AF995636250@microsoft.com...
Re-bonjour ;

Cette solution marche très bien pour ce que j'ai demandé. mais puisque les
experts lèvent toujours les défits (Merci Michdenis), je vais abuser.
Supposons que je doive aussi faire des sous-totaux pour C:C et D:D, comment
transformer ou compléter le code de Michdenis.

Salutations

Bonjour Izmi,

Évidemment, cela dépend du tableau de départ :

Colonne A:A Les dates
Colonne B:B Les données à additionner :

'---------------------------------
Sub Sous_Totaux()

With Worksheets("Feuil1")
.Columns(1).Insert Shift:=xlToRight
Set Rg = .Range("A1:C" & .Range("B65536").End(xlUp).Row)
End With
With Rg
.Columns(1).Offset(1).Resize(Rg.Rows.Count - 1).FormulaLocal = _
"=année(" & Rg.Parent.Name & "!" & Rg(2, (Rg.Offset(1).Row)).Address(0, 0) & ")"
.Item(1, 1) = "Année"
.Subtotal GroupBy:=1, Function:=xlSum, TotalList:=Array(3), _
Replace:=True, PageBreaks:úlse, SummaryBelowData:=True
End With

End Sub
'---------------------------------


Salutations!




"Izmi" <Izmi@discussions.microsoft.com> a écrit dans le message de news: DD6F5F68-41CD-4D29-B17E-0AD9CBDF7E53@microsoft.com...
C qui ne va pas :

1) Avec ton dernier code j'obtiens les totaux des dates et non des montants
.. Mon tableau d'exemple est ainsi conçu :
A B
Dates/jour Montants
01/02/O3 127
03/02/03 210
.. .
.. .
12/03/O3 400
.. .
.. .
10/12/04 456
15/12/04 987
..
..
23/05/05
14/05/05
2) Avec mon bric à brac, ça marche très bien pour mon petit tableau
d'exemple mais pour le grand tableau seules les montants de la première année
sont additionnés. Pour les autres années pas de sous-totaux.

Salutations

Et si tu donnais des précisions sur ce qui ne va pas ...


Salutations!


"Izmi" <Izmi@discussions.microsoft.com> a écrit dans le message de news: BED5B345-8B47-4833-BC88-70259124625B@microsoft.com...
Encore un petit effort Michdenis :)
Ce n'est pas tout à fait au point. Mais là tu t'endoutais déjà.
Mon bric à brac répond mieux à ce que je souhaite, sauf que, malheureusement
il n'est pas adapté aux grands tableaux. Je viens d'en faire un test.
Merci encore

Bonjour Izmi,

Il y a aussi ceci :

Cependant, je ne suis pas sûr que la fonction "xlSum" soit la plus appropriée.

'-------------------------
Sub Sous_Totaux()

With Worksheets("Feuil1")
Set Rg = .Range("A1:A" & .Range("A65536").End(xlUp).Row)
End With
With Rg
.Insert Shift:=xlToRight
.Item(1, 1).Offset(, -1) = "Année"
.Offset(1, -1).Resize(Rg.Rows.Count - 1).FormulaLocal = _
"=année(" & Rg.Parent.Name & "!" & Rg(Rg.Offset(1).Row).Address(0, 0) & ")"
.Offset(, -1).Subtotal GroupBy:=1, Function:=xlSum, TotalList:=Array(1), _
Replace:=True, PageBreaks:úlse, SummaryBelowData:=True
End With

End Sub
'-------------------------


Salutations!



"Izmi" <Izmi@discussions.microsoft.com> a écrit dans le message de news: 4F97CA4F-2D8E-401D-A0BC-A029518ED0AE@microsoft.com...
Bonjour ;

Sous réserve de confirmation par nos chers experts, je crois avoir réussi à
faire des sous-totaux par année pour une liste de jours.
Comment ?
En mettant bout à bout deux idées que MichDenis m'a soufflé (post du
14/10/O5 et d'aujourd'hui.) et en maniant l'enregistreur de macro.

En procédant ainsi je n'est peut être pas fait quelque chose de fini. Les
experts pourront peut être affiner.

Sub Macro1()
'
' Macro1 Macro
' Macro enregistrée le 16/10/2005 par Izmi
'

'
Columns("A:A").Select
Selection.Insert Shift:=xlToRight
Range("A2").Select
ActiveCell.FormulaR1C1 = "=YEAR(RC[1])"
Range("A2").Select
Selection.AutoFill Destination:=Range("A2:A30")
Range("A2:A30").Select
Range("B2").Select
Selection.Subtotal GroupBy:=1, Function:=xlSum, TotalList:=Array(3), _
Replace:=True, PageBreaks:úlse, SummaryBelowData:=True
Test
End Sub

Sub Test()
Dim Rg As Range
With Worksheets("Feuil1")
Set Rg = .Range("A1:A" & .Range("A65536").End(xlUp).Row)
End With
For Each c In Rg
If c.Characters.Font.Bold = True Then
c.Offset(, 1) = c
c.Offset(, 1).Characters.Font.Bold = True
End If
Next
Rg.EntireColumn.Delete xlToLeft
Set Rg = Nothing
End Sub

Le code final obtenu et semble bien marcher est le suivant :

Bonjour tout le monde;
Bonjour Michdenis ;

C'est formidable. Je ne sais pas si un tel code a déjà été proposé quelque
part, mais, en tout cas, je ne l'ai pas trouvé ailleurs.

Pour que tout le monde puisse en profiter, je suggére, avec ta permission,
que notre amie Florence l'héberge dans "Excelabo".

Je voudrais quand même poser une autre question : Serait-il possible que les
sous totaux qui se dégagent soient automatiquement mis en rouge et en gras ?

Merci encore

Bonjour Izmi,

'------
Tableau de base avant d'exécuter la procédure :
Colonne 1 = Les dates
Colonne 2,3,4 des données de type numérique
'------


Voici 2 versions de la même procédure... choisis celle qui te semble la plus maléable !!!

La section intéressante est celle-ci :
.Subtotal GroupBy:=1, Function:=xlSum, TotalList:=Array(3, 4, 5),
1 = le numéro de la colonne de la plage à partir de laquelle s'effectue le regroupement

3,4,5 = Numéro de la colonne pour lesquelles seront calculés la somme à chaque changement d'années de la colonne 1


'-------------------------------
Sub Sous_Totaux()

With Worksheets("Feuil1")
.Columns(1).Insert Shift:=xlToRight
Set rg = .Range("A1:F" & .Range("B65536").End(xlUp).Row)
End With
With rg
.Columns(1).Offset(1).Resize(rg.Rows.Count - 1).FormulaLocal = _
"=année(" & rg.Parent.Name & "!" & rg(2, (rg.Offset(1).Row)).Address(0, 0) & ")"
.Item(1, 1) = "Année"
.Subtotal GroupBy:=1, Function:=xlSum, TotalList:=Array(3, 4, 5), _
Replace:=True, PageBreaks:úlse, SummaryBelowData:=True
End With

End Sub

'-------------------------------
Sub Sous_Totaux2()

With Worksheets("Feuil1")
.Columns(1).Insert Shift:=xlToRight
Set rg = .Range("A1:F" & .Range("B65536").End(xlUp).Row)
End With
With rg
.Item(1, 1) = "Année"
.Item(2, 1).FormulaLocal = "=année(" & .Item(2, 2).Address(0, 0) & ")"
Range(.Item(2, 1).Cells, .Item(rg.Rows.Count, 1).Cells).FillDown
.Subtotal GroupBy:=1, Function:=xlSum, TotalList:=Array(3, 4, 5), _
Replace:=True, PageBreaks:úlse, SummaryBelowData:=True
End With

End Sub
'-------------------------------


Salutations!





"Izmi" <Izmi@discussions.microsoft.com> a écrit dans le message de news: 7D6DB4F7-CF54-4F8D-8C2C-6AF995636250@microsoft.com...
Re-bonjour ;

Cette solution marche très bien pour ce que j'ai demandé. mais puisque les
experts lèvent toujours les défits (Merci Michdenis), je vais abuser.
Supposons que je doive aussi faire des sous-totaux pour C:C et D:D, comment
transformer ou compléter le code de Michdenis.

Salutations

Bonjour Izmi,

Évidemment, cela dépend du tableau de départ :

Colonne A:A Les dates
Colonne B:B Les données à additionner :

'---------------------------------
Sub Sous_Totaux()

With Worksheets("Feuil1")
.Columns(1).Insert Shift:=xlToRight
Set Rg = .Range("A1:C" & .Range("B65536").End(xlUp).Row)
End With
With Rg
.Columns(1).Offset(1).Resize(Rg.Rows.Count - 1).FormulaLocal = _
"=année(" & Rg.Parent.Name & "!" & Rg(2, (Rg.Offset(1).Row)).Address(0, 0) & ")"
.Item(1, 1) = "Année"
.Subtotal GroupBy:=1, Function:=xlSum, TotalList:=Array(3), _
Replace:=True, PageBreaks:úlse, SummaryBelowData:=True
End With

End Sub
'---------------------------------


Salutations!




"Izmi" <Izmi@discussions.microsoft.com> a écrit dans le message de news: DD6F5F68-41CD-4D29-B17E-0AD9CBDF7E53@microsoft.com...
C qui ne va pas :

1) Avec ton dernier code j'obtiens les totaux des dates et non des montants
.. Mon tableau d'exemple est ainsi conçu :
A B
Dates/jour Montants
01/02/O3 127
03/02/03 210
.. .
.. .
12/03/O3 400
.. .
.. .
10/12/04 456
15/12/04 987
..
..
23/05/05
14/05/05
2) Avec mon bric à brac, ça marche très bien pour mon petit tableau
d'exemple mais pour le grand tableau seules les montants de la première année
sont additionnés. Pour les autres années pas de sous-totaux.

Salutations

Et si tu donnais des précisions sur ce qui ne va pas ...


Salutations!


"Izmi" <Izmi@discussions.microsoft.com> a écrit dans le message de news: BED5B345-8B47-4833-BC88-70259124625B@microsoft.com...
Encore un petit effort Michdenis :)
Ce n'est pas tout à fait au point. Mais là tu t'endoutais déjà.
Mon bric à brac répond mieux à ce que je souhaite, sauf que, malheureusement
il n'est pas adapté aux grands tableaux. Je viens d'en faire un test.
Merci encore

Bonjour Izmi,

Il y a aussi ceci :

Cependant, je ne suis pas sûr que la fonction "xlSum" soit la plus appropriée.

'-------------------------
Sub Sous_Totaux()

With Worksheets("Feuil1")
Set Rg = .Range("A1:A" & .Range("A65536").End(xlUp).Row)
End With
With Rg
.Insert Shift:=xlToRight
.Item(1, 1).Offset(, -1) = "Année"
.Offset(1, -1).Resize(Rg.Rows.Count - 1).FormulaLocal = _
"=année(" & Rg.Parent.Name & "!" & Rg(Rg.Offset(1).Row).Address(0, 0) & ")"
.Offset(, -1).Subtotal GroupBy:=1, Function:=xlSum, TotalList:=Array(1), _
Replace:=True, PageBreaks:úlse, SummaryBelowData:=True
End With

End Sub
'-------------------------


Salutations!



"Izmi" <Izmi@discussions.microsoft.com> a écrit dans le message de news: 4F97CA4F-2D8E-401D-A0BC-A029518ED0AE@microsoft.com...
Bonjour ;

Sous réserve de confirmation par nos chers experts, je crois avoir réussi à
faire des sous-totaux par année pour une liste de jours.
Comment ?
En mettant bout à bout deux idées que MichDenis m'a soufflé (post du
14/10/O5 et d'aujourd'hui.) et en maniant l'enregistreur de macro.

En procédant ainsi je n'est peut être pas fait quelque chose de fini. Les
experts pourront peut être affiner.

Sub Macro1()
'
' Macro1 Macro
' Macro enregistrée le 16/10/2005 par Izmi
'

'
Columns("A:A").Select
Selection.Insert Shift:=xlToRight
Range("A2").Select
ActiveCell.FormulaR1C1 = "=YEAR(RC[1])"
Range("A2").Select
Selection.AutoFill Destination:=Range("A2:A30")
Range("A2:A30").Select
Range("B2").Select
Selection.Subtotal GroupBy:=1, Function:=xlSum, TotalList:=Array(3), _
Replace:=True, PageBreaks:úlse, SummaryBelowData:=True
Test
End Sub

Sub Test()
Dim Rg As Range
With Worksheets("Feuil1")
Set Rg = .Range("A1:A" & .Range("A65536").End(xlUp).Row)
End With
For Each c In Rg
If c.Characters.Font.Bold = True Then
c.Offset(, 1) = c
c.Offset(, 1).Characters.Font.Bold = True
End If
Next
Rg.EntireColumn.Delete xlToLeft
Set Rg = Nothing
End Sub

Le code final obtenu et semble bien marcher est le suivant :

Bonjour Izmi,

Voici 2 façons de faire. Il y en a d'autres. La bonne méthode dépend surtout des caractéristiques de la plage concernée.

P.S. Si tu veux envoyer le tout à Misange, je compte sur toi pour lui préparer un fichier exemple avec notes explicatives à
l'intérieur du fichier pour que les usagers du forum s'y retrouve. Comme c'est toi qui préparera ce fichier... le propriétaire du
fichier, des procédures et des explications sera donc toi.

Cette façon exige qu'il n'y ait pas d'autres formules que les
formules de sous-totaux dans les colonnes visées
'-----------------------------------
Sub Sous_Totaux1()

Dim Rg As Range

With Worksheets("Feuil1")
.Columns(1).Insert Shift:=xlToRight
Set Rg = .Range("A1:F" & .Range("B65536").End(xlUp).Row)
End With
On Error Resume Next
With Rg
.Item(1, 1) = "Année"
.Item(2, 1).FormulaLocal = "=année(" & .Item(2, 2).Address(0, 0) & ")"
Range(.Item(2, 1).Cells, .Item(Rg.Rows.Count, 1).Cells).FillDown
.Subtotal GroupBy:=1, Function:=xlSum, TotalList:=Array(3, 4, 5), _
Replace:=True, PageBreaks:úlse, SummaryBelowData:=True
With .Offset(, 2).Resize(, Rg.Columns.Count - 2).EntireColumn _
.SpecialCells(xlCellTypeFormulas)
.Font.ColorIndex = 3
.Font.Bold = True
End With
End With
Set Rg = Nothing

End Sub
'-----------------------------------



La mise en forme des lignes de sous-totaux se fait par une recherche
du mot "total" dans la colonne 1 de la plage.
'-----------------------------------
Sub Sous_Totaux2()

Dim Rg As Range, C As Range, FirstAddress As String

With Worksheets("Feuil1")
.Columns(1).Insert Shift:=xlToRight
Set Rg = .Range("A1:F" & .Range("B65536").End(xlUp).Row)
End With
On Error Resume Next
With Rg
.Item(1, 1) = "Année"
.Item(2, 1).FormulaLocal = "=année(" & .Item(2, 2).Address(0, 0) & ")"
Range(.Item(2, 1).Cells, .Item(Rg.Rows.Count, 1).Cells).FillDown
.Subtotal GroupBy:=1, Function:=xlSum, TotalList:=Array(3, 4, 5), _
Replace:=True, PageBreaks:úlse, SummaryBelowData:=True
With .EntireColumn
Set C = .Find("Total", LookIn:=xlValues, lookat:=xlPart)
If Not C Is Nothing Then
FirstAddress = C.Address
Do
With C.Resize(, 5)
.Font.ColorIndex = 3
.Font.Bold = True
End With
Set C = .FindNext(C)
Loop While Not C Is Nothing And C.Address <> FirstAddress
End If
End With

End With
Set Rg = Nothing: Set C = Nothing

End Sub
'-----------------------------------


Salutations!






"Izmi" <Izmi@discussions.microsoft.com> a écrit dans le message de news: D3326671-E1F3-4084-BC9E-C56604A168CE@microsoft.com...
Bonjour tout le monde;
Bonjour Michdenis ;

C'est formidable. Je ne sais pas si un tel code a déjà été proposé quelque
part, mais, en tout cas, je ne l'ai pas trouvé ailleurs.

Pour que tout le monde puisse en profiter, je suggére, avec ta permission,
que notre amie Florence l'héberge dans "Excelabo".

Je voudrais quand même poser une autre question : Serait-il possible que les
sous totaux qui se dégagent soient automatiquement mis en rouge et en gras ?

Merci encore

Bonjour Izmi,

'------
Tableau de base avant d'exécuter la procédure :
Colonne 1 = Les dates
Colonne 2,3,4 des données de type numérique
'------


Voici 2 versions de la même procédure... choisis celle qui te semble la plus maléable !!!

La section intéressante est celle-ci :
.Subtotal GroupBy:=1, Function:=xlSum, TotalList:=Array(3, 4, 5),
1 = le numéro de la colonne de la plage à partir de laquelle s'effectue le regroupement

3,4,5 = Numéro de la colonne pour lesquelles seront calculés la somme à chaque changement d'années de la colonne 1


'-------------------------------
Sub Sous_Totaux()

With Worksheets("Feuil1")
.Columns(1).Insert Shift:=xlToRight
Set rg = .Range("A1:F" & .Range("B65536").End(xlUp).Row)
End With
With rg
.Columns(1).Offset(1).Resize(rg.Rows.Count - 1).FormulaLocal = _
"=année(" & rg.Parent.Name & "!" & rg(2, (rg.Offset(1).Row)).Address(0, 0) & ")"
.Item(1, 1) = "Année"
.Subtotal GroupBy:=1, Function:=xlSum, TotalList:=Array(3, 4, 5), _
Replace:=True, PageBreaks:úlse, SummaryBelowData:=True
End With

End Sub

'-------------------------------
Sub Sous_Totaux2()

With Worksheets("Feuil1")
.Columns(1).Insert Shift:=xlToRight
Set rg = .Range("A1:F" & .Range("B65536").End(xlUp).Row)
End With
With rg
.Item(1, 1) = "Année"
.Item(2, 1).FormulaLocal = "=année(" & .Item(2, 2).Address(0, 0) & ")"
Range(.Item(2, 1).Cells, .Item(rg.Rows.Count, 1).Cells).FillDown
.Subtotal GroupBy:=1, Function:=xlSum, TotalList:=Array(3, 4, 5), _
Replace:=True, PageBreaks:úlse, SummaryBelowData:=True
End With

End Sub
'-------------------------------


Salutations!





"Izmi" <Izmi@discussions.microsoft.com> a écrit dans le message de news: 7D6DB4F7-CF54-4F8D-8C2C-6AF995636250@microsoft.com...
Re-bonjour ;

Cette solution marche très bien pour ce que j'ai demandé. mais puisque les
experts lèvent toujours les défits (Merci Michdenis), je vais abuser.
Supposons que je doive aussi faire des sous-totaux pour C:C et D:D, comment
transformer ou compléter le code de Michdenis.

Salutations

Bonjour Izmi,

Évidemment, cela dépend du tableau de départ :

Colonne A:A Les dates
Colonne B:B Les données à additionner :

'---------------------------------
Sub Sous_Totaux()

With Worksheets("Feuil1")
.Columns(1).Insert Shift:=xlToRight
Set Rg = .Range("A1:C" & .Range("B65536").End(xlUp).Row)
End With
With Rg
.Columns(1).Offset(1).Resize(Rg.Rows.Count - 1).FormulaLocal = _
"=année(" & Rg.Parent.Name & "!" & Rg(2, (Rg.Offset(1).Row)).Address(0, 0) & ")"
.Item(1, 1) = "Année"
.Subtotal GroupBy:=1, Function:=xlSum, TotalList:=Array(3), _
Replace:=True, PageBreaks:úlse, SummaryBelowData:=True
End With

End Sub
'---------------------------------


Salutations!




"Izmi" <Izmi@discussions.microsoft.com> a écrit dans le message de news: DD6F5F68-41CD-4D29-B17E-0AD9CBDF7E53@microsoft.com...
C qui ne va pas :

1) Avec ton dernier code j'obtiens les totaux des dates et non des montants
.. Mon tableau d'exemple est ainsi conçu :
A B
Dates/jour Montants
01/02/O3 127
03/02/03 210
.. .
.. .
12/03/O3 400
.. .
.. .
10/12/04 456
15/12/04 987
..
..
23/05/05
14/05/05
2) Avec mon bric à brac, ça marche très bien pour mon petit tableau
d'exemple mais pour le grand tableau seules les montants de la première année
sont additionnés. Pour les autres années pas de sous-totaux.

Salutations

Et si tu donnais des précisions sur ce qui ne va pas ...


Salutations!


"Izmi" <Izmi@discussions.microsoft.com> a écrit dans le message de news: BED5B345-8B47-4833-BC88-70259124625B@microsoft.com...
Encore un petit effort Michdenis :)
Ce n'est pas tout à fait au point. Mais là tu t'endoutais déjà.
Mon bric à brac répond mieux à ce que je souhaite, sauf que, malheureusement
il n'est pas adapté aux grands tableaux. Je viens d'en faire un test.
Merci encore

Bonjour Izmi,

Il y a aussi ceci :

Cependant, je ne suis pas sûr que la fonction "xlSum" soit la plus appropriée.

'-------------------------
Sub Sous_Totaux()

With Worksheets("Feuil1")
Set Rg = .Range("A1:A" & .Range("A65536").End(xlUp).Row)
End With
With Rg
.Insert Shift:=xlToRight
.Item(1, 1).Offset(, -1) = "Année"
.Offset(1, -1).Resize(Rg.Rows.Count - 1).FormulaLocal = _
"=année(" & Rg.Parent.Name & "!" & Rg(Rg.Offset(1).Row).Address(0, 0) & ")"
.Offset(, -1).Subtotal GroupBy:=1, Function:=xlSum, TotalList:=Array(1), _
Replace:=True, PageBreaks:úlse, SummaryBelowData:=True
End With

End Sub
'-------------------------


Salutations!



"Izmi" <Izmi@discussions.microsoft.com> a écrit dans le message de news:
4F97CA4F-2D8E-401D-A0BC-A029518ED0AE@microsoft.com...
Bonjour ;

Sous réserve de confirmation par nos chers experts, je crois avoir réussi à
faire des sous-totaux par année pour une liste de jours.
Comment ?
En mettant bout à bout deux idées que MichDenis m'a soufflé (post du
14/10/O5 et d'aujourd'hui.) et en maniant l'enregistreur de macro.

En procédant ainsi je n'est peut être pas fait quelque chose de fini. Les
experts pourront peut être affiner.

Sub Macro1()
'
' Macro1 Macro
' Macro enregistrée le 16/10/2005 par Izmi
'

'
Columns("A:A").Select
Selection.Insert Shift:=xlToRight
Range("A2").Select
ActiveCell.FormulaR1C1 = "=YEAR(RC[1])"
Range("A2").Select
Selection.AutoFill Destination:=Range("A2:A30")
Range("A2:A30").Select
Range("B2").Select
Selection.Subtotal GroupBy:=1, Function:=xlSum, TotalList:=Array(3), _
Replace:=True, PageBreaks:úlse, SummaryBelowData:=True
Test
End Sub

Sub Test()
Dim Rg As Range
With Worksheets("Feuil1")
Set Rg = .Range("A1:A" & .Range("A65536").End(xlUp).Row)
End With
For Each c In Rg
If c.Characters.Font.Bold = True Then
c.Offset(, 1) = c
c.Offset(, 1).Characters.Font.Bold = True
End If
Next
Rg.EntireColumn.Delete xlToLeft
Set Rg = Nothing
End Sub

Le code final obtenu et semble bien marcher est le suivant :

Merci. C'est parfait

Bonjour Izmi,

Voici 2 façons de faire. Il y en a d'autres. La bonne méthode dépend surtout des caractéristiques de la plage concernée.

P.S. Si tu veux envoyer le tout à Misange, je compte sur toi pour lui préparer un fichier exemple avec notes explicatives à
l'intérieur du fichier pour que les usagers du forum s'y retrouve. Comme c'est toi qui préparera ce fichier... le propriétaire du
fichier, des procédures et des explications sera donc toi.

Cette façon exige qu'il n'y ait pas d'autres formules que les
formules de sous-totaux dans les colonnes visées
'-----------------------------------
Sub Sous_Totaux1()

Dim Rg As Range

With Worksheets("Feuil1")
.Columns(1).Insert Shift:=xlToRight
Set Rg = .Range("A1:F" & .Range("B65536").End(xlUp).Row)
End With
On Error Resume Next
With Rg
.Item(1, 1) = "Année"
.Item(2, 1).FormulaLocal = "=année(" & .Item(2, 2).Address(0, 0) & ")"
Range(.Item(2, 1).Cells, .Item(Rg.Rows.Count, 1).Cells).FillDown
.Subtotal GroupBy:=1, Function:=xlSum, TotalList:=Array(3, 4, 5), _
Replace:=True, PageBreaks:úlse, SummaryBelowData:=True
With .Offset(, 2).Resize(, Rg.Columns.Count - 2).EntireColumn _
.SpecialCells(xlCellTypeFormulas)
.Font.ColorIndex = 3
.Font.Bold = True
End With
End With
Set Rg = Nothing

End Sub
'-----------------------------------



La mise en forme des lignes de sous-totaux se fait par une recherche
du mot "total" dans la colonne 1 de la plage.
'-----------------------------------
Sub Sous_Totaux2()

Dim Rg As Range, C As Range, FirstAddress As String

With Worksheets("Feuil1")
.Columns(1).Insert Shift:=xlToRight
Set Rg = .Range("A1:F" & .Range("B65536").End(xlUp).Row)
End With
On Error Resume Next
With Rg
.Item(1, 1) = "Année"
.Item(2, 1).FormulaLocal = "=année(" & .Item(2, 2).Address(0, 0) & ")"
Range(.Item(2, 1).Cells, .Item(Rg.Rows.Count, 1).Cells).FillDown
.Subtotal GroupBy:=1, Function:=xlSum, TotalList:=Array(3, 4, 5), _
Replace:=True, PageBreaks:úlse, SummaryBelowData:=True
With .EntireColumn
Set C = .Find("Total", LookIn:=xlValues, lookat:=xlPart)
If Not C Is Nothing Then
FirstAddress = C.Address
Do
With C.Resize(, 5)
.Font.ColorIndex = 3
.Font.Bold = True
End With
Set C = .FindNext(C)
Loop While Not C Is Nothing And C.Address <> FirstAddress
End If
End With

End With
Set Rg = Nothing: Set C = Nothing

End Sub
'-----------------------------------


Salutations!






"Izmi" <Izmi@discussions.microsoft.com> a écrit dans le message de news: D3326671-E1F3-4084-BC9E-C56604A168CE@microsoft.com...
Bonjour tout le monde;
Bonjour Michdenis ;

C'est formidable. Je ne sais pas si un tel code a déjà été proposé quelque
part, mais, en tout cas, je ne l'ai pas trouvé ailleurs.

Pour que tout le monde puisse en profiter, je suggére, avec ta permission,
que notre amie Florence l'héberge dans "Excelabo".

Je voudrais quand même poser une autre question : Serait-il possible que les
sous totaux qui se dégagent soient automatiquement mis en rouge et en gras ?

Merci encore

Bonjour Izmi,

'------
Tableau de base avant d'exécuter la procédure :
Colonne 1 = Les dates
Colonne 2,3,4 des données de type numérique
'------


Voici 2 versions de la même procédure... choisis celle qui te semble la plus maléable !!!

La section intéressante est celle-ci :
.Subtotal GroupBy:=1, Function:=xlSum, TotalList:=Array(3, 4, 5),
1 = le numéro de la colonne de la plage à partir de laquelle s'effectue le regroupement

3,4,5 = Numéro de la colonne pour lesquelles seront calculés la somme à chaque changement d'années de la colonne 1


'-------------------------------
Sub Sous_Totaux()

With Worksheets("Feuil1")
.Columns(1).Insert Shift:=xlToRight
Set rg = .Range("A1:F" & .Range("B65536").End(xlUp).Row)
End With
With rg
.Columns(1).Offset(1).Resize(rg.Rows.Count - 1).FormulaLocal = _
"=année(" & rg.Parent.Name & "!" & rg(2, (rg.Offset(1).Row)).Address(0, 0) & ")"
.Item(1, 1) = "Année"
.Subtotal GroupBy:=1, Function:=xlSum, TotalList:=Array(3, 4, 5), _
Replace:=True, PageBreaks:úlse, SummaryBelowData:=True
End With

End Sub

'-------------------------------
Sub Sous_Totaux2()

With Worksheets("Feuil1")
.Columns(1).Insert Shift:=xlToRight
Set rg = .Range("A1:F" & .Range("B65536").End(xlUp).Row)
End With
With rg
.Item(1, 1) = "Année"
.Item(2, 1).FormulaLocal = "=année(" & .Item(2, 2).Address(0, 0) & ")"
Range(.Item(2, 1).Cells, .Item(rg.Rows.Count, 1).Cells).FillDown
.Subtotal GroupBy:=1, Function:=xlSum, TotalList:=Array(3, 4, 5), _
Replace:=True, PageBreaks:úlse, SummaryBelowData:=True
End With

End Sub
'-------------------------------


Salutations!





"Izmi" <Izmi@discussions.microsoft.com> a écrit dans le message de news: 7D6DB4F7-CF54-4F8D-8C2C-6AF995636250@microsoft.com...
Re-bonjour ;

Cette solution marche très bien pour ce que j'ai demandé. mais puisque les
experts lèvent toujours les défits (Merci Michdenis), je vais abuser.
Supposons que je doive aussi faire des sous-totaux pour C:C et D:D, comment
transformer ou compléter le code de Michdenis.

Salutations

Bonjour Izmi,

Évidemment, cela dépend du tableau de départ :

Colonne A:A Les dates
Colonne B:B Les données à additionner :

'---------------------------------
Sub Sous_Totaux()

With Worksheets("Feuil1")
.Columns(1).Insert Shift:=xlToRight
Set Rg = .Range("A1:C" & .Range("B65536").End(xlUp).Row)
End With
With Rg
.Columns(1).Offset(1).Resize(Rg.Rows.Count - 1).FormulaLocal = _
"=année(" & Rg.Parent.Name & "!" & Rg(2, (Rg.Offset(1).Row)).Address(0, 0) & ")"
.Item(1, 1) = "Année"
.Subtotal GroupBy:=1, Function:=xlSum, TotalList:=Array(3), _
Replace:=True, PageBreaks:úlse, SummaryBelowData:=True
End With

End Sub
'---------------------------------


Salutations!




"Izmi" <Izmi@discussions.microsoft.com> a écrit dans le message de news: DD6F5F68-41CD-4D29-B17E-0AD9CBDF7E53@microsoft.com...
C qui ne va pas :

1) Avec ton dernier code j'obtiens les totaux des dates et non des montants
.. Mon tableau d'exemple est ainsi conçu :
A B
Dates/jour Montants
01/02/O3 127
03/02/03 210
.. .
.. .
12/03/O3 400
.. .
.. .
10/12/04 456
15/12/04 987
..
..
23/05/05
14/05/05
2) Avec mon bric à brac, ça marche très bien pour mon petit tableau
d'exemple mais pour le grand tableau seules les montants de la première année
sont additionnés. Pour les autres années pas de sous-totaux.

Salutations

Et si tu donnais des précisions sur ce qui ne va pas ...


Salutations!


"Izmi" <Izmi@discussions.microsoft.com> a écrit dans le message de news: BED5B345-8B47-4833-BC88-70259124625B@microsoft.com...
Encore un petit effort Michdenis :)
Ce n'est pas tout à fait au point. Mais là tu t'endoutais déjà.
Mon bric à brac répond mieux à ce que je souhaite, sauf que, malheureusement
il n'est pas adapté aux grands tableaux. Je viens d'en faire un test.
Merci encore

Bonjour Izmi,

Il y a aussi ceci :

Cependant, je ne suis pas sûr que la fonction "xlSum" soit la plus appropriée.

'-------------------------
Sub Sous_Totaux()

With Worksheets("Feuil1")
Set Rg = .Range("A1:A" & .Range("A65536").End(xlUp).Row)
End With
With Rg
.Insert Shift:=xlToRight
.Item(1, 1).Offset(, -1) = "Année"
.Offset(1, -1).Resize(Rg.Rows.Count - 1).FormulaLocal = _
"=année(" & Rg.Parent.Name & "!" & Rg(Rg.Offset(1).Row).Address(0, 0) & ")"
.Offset(, -1).Subtotal GroupBy:=1, Function:=xlSum, TotalList:=Array(1), _
Replace:=True, PageBreaks:úlse, SummaryBelowData:=True
End With

End Sub
'-------------------------


Salutations!



"Izmi" <Izmi@discussions.microsoft.com> a écrit dans le message de news:
4F97CA4F-2D8E-401D-A0BC-A029518ED0AE@microsoft.com...
Bonjour ;

Sous réserve de confirmation par nos chers experts, je crois avoir réussi à
faire des sous-totaux par année pour une liste de jours.
Comment ?
En mettant bout à bout deux idées que MichDenis m'a soufflé (post du
14/10/O5 et d'aujourd'hui.) et en maniant l'enregistreur de macro.

En procédant ainsi je n'est peut être pas fait quelque chose de fini. Les
experts pourront peut être affiner.

Sub Macro1()
'
' Macro1 Macro
' Macro enregistrée le 16/10/2005 par Izmi
'

'
Columns("A:A").Select
Selection.Insert Shift:=xlToRight
Range("A2").Select