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
| Sub SousTotal()
Dim LastLig As Long
Dim c As Range
Application.ScreenUpdating = False
With Worksheets("Feuil1")
.AutoFilterMode = False
.UsedRange.RemoveSubtotal
LastLig = .Cells(.Rows.Count, "A").End(xlUp).Row
'On extrait l'info qui nous concerne via la formule en colonne A qu'on vient d'insérer temporairement
.Columns(1).Insert
With .Range("A2:A" & LastLig)
.Formula = "=SUBSTITUTE(LEFT(B2,FIND(""Series"",B2)-2),""iTraxx "","""")"
.Value = .Value
End With
'On tri et on réalise notre sous total
With .Range("A1:C" & LastLig)
.Sort Key1:=.Range("A2"), Order1:=xlAscending, Header:=xlYes
.Subtotal GroupBy:=1, Function:=xlSum, TotalList:=Array(3), Replace:=True, PageBreaks:=False, SummaryBelowData:=True
End With
'on reporte l'intitulé des lignes sous totaux (à l'aide d'un filtre automatique et report des intitulé)
LastLig = .Cells(.Rows.Count, "A").End(xlUp).Row
With .Range("B1:B" & LastLig)
.AutoFilter Field:=1, Criteria1:=""
For Each c In .SpecialCells(xlCellTypeVisible)
c.EntireRow.Font.Bold = True
If c.Value = "" Then c.Value = c.Offset(0, -1).Value
Next c
End With
.AutoFilterMode = False
'on supprime la colonne 1
.Columns(1).Delete
End With
End Sub |
Sous total par suffixe en VBA
Répondre avec citation
Partager