Discussion :

[sigma17]

bonjour la communauté,voilà j'aimerais savoir s'il est possible de regrouper les montants de plusieurs ligne selon le critère du contenue d'une cellule de ces lignes.ma phrase n'est pas très nette,je fais un petit exemple pour mieux illustrer:fichier joint
je veux regrouper(faire la somme)de mes lignes selon les trois premiers chiffres de la colonne "num cpte".
j'espère m'être bien fais comprendre.merci d'avance pour votre aide

[mercatog]

Ajoute une colonne avec les 3 premiers chiffres des N° de compte et fais un sous total d'Excel.

[goldstar]

Bonjour,

un petit code

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
 
Sub test()
 
Dim ligneFin As Integer, ligneDeb As Integer, nbVal As Integer
Dim cpt_l As Integer, ligne_deb As Integer, ligne_fin As Integer
Dim val_defaut As String, val As String
 
 
derLigne = Sheets("tableau initial").Range("a" & Rows.Count).End(xlUp).Row
 
'Suppression des données dans la feuille "tableau final"
Sheets("tableau final").Cells.Clear
 
'Copie des données de la feuille "tableau initial" vers la feuille "tableau final"
For cpt_l = 1 To derLigne
    Sheets("tableau final").Cells(cpt_l, 1) = Sheets("tableau initial").Cells(cpt_l, 1)
    Sheets("tableau final").Cells(cpt_l, 2) = Sheets("tableau initial").Cells(cpt_l, 2)
    Sheets("tableau final").Cells(cpt_l, 3) = Sheets("tableau initial").Cells(cpt_l, 3)
    Sheets("tableau final").Cells(cpt_l, 4) = Sheets("tableau initial").Cells(cpt_l, 4)
    Sheets("tableau final").Cells(cpt_l, 5) = Sheets("tableau initial").Cells(cpt_l, 5)
    Sheets("tableau final").Cells(cpt_l, 6) = Left(Sheets("tableau initial").Cells(cpt_l, 1), 3)
Next cpt_l
 
derLigne = Sheets("tableau final").Range("a" & Rows.Count).End(xlUp).Row
val_defaut = Left(Sheets("tableau final").Cells(1, 1), 3)
 
For cpt_l = 1 To Sheets("tableau final").Range("a" & Rows.Count).End(xlUp).Row
    ligneDeb = cpt_l
    nbVal = Application.WorksheetFunction.CountIf(Sheets("tableau final").Range(Cells(ligneDeb, 6), Cells(derLigne, 6)), val_defaut)
    ligneFin = ligneDeb + nbVal
 
    'Ajout de la ligne total
    Sheets("tableau final").Rows(ligneFin).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    Sheets("tableau final").Cells(ligneFin, 1) = val_defaut
 
    'Mise en place de la formule
    Sheets("tableau final").Cells(ligneFin, 4).FormulaLocal = "=SOMME(" & Cells(ligneDeb, 4).Address & ":" & Cells(ligneFin - 1, 4).Address & ")"
    Sheets("tableau final").Cells(ligneFin, 5).FormulaLocal = "=SOMME(" & Cells(ligneDeb, 5).Address & ":" & Cells(ligneFin - 1, 5).Address & ")"
 
    Sheets("tableau final").Range(Cells(ligneFin, 1), Cells(ligneFin, 6)).Interior.ColorIndex = 6
 
    cpt_l = ligneFin
    derLigne = Sheets("tableau final").Range("a" & Rows.Count).End(xlUp).Row
    val_defaut = Left(Sheets("tableau initial").Cells(cpt_l + 1, 1), 3)
 
Next cpt_l
 
 
 
End Sub

[sigma17]

merci bien à vous goldstar et mercatog.
concernant les sous totaux que tu me propose mercatog,mes données sont trop nombreuse donc cela me revient très fastidieux,mais ton astuce me servira certainement.
quand à ton code goldstar,il marche mais pas totalement car sur certaines feuille il n'arrive pas a faire les regroupement correctement.je joins une feuille exemple pour que tu jette un coup d’œil.
Cordialement.

[goldstar]

Il me faudrais le fichier avec la macro

[sigma17]

la macro s'exécute après avoir clické sur le bouton "test",
j'ai juste copié le code derrière le bouton "test",je n'arrive pas à télécharger le fichier avec l’extension .xlm(avec la macro incorporée).
Cordialement.

[sigma17]

je reviens encore sur ton code goldstar,il marche parfaitement maintenantil y avait une petite erreur à la ligne 44,au lieu de "tableau final" c'est "tableau initial" qui est marqué.merci encore à tous pour votre aide,particulièrement à toi goldstar.
Cordialement

[mercatog]

Recréer la roue?

Avec sous total d'excel exprimé en vba

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
Sub SousTotaux()
Dim LastLig As Long
 
Application.ScreenUpdating = False
With Worksheets("tableau final")
    .UsedRange.ClearContents
    Worksheets("tableau initial").UsedRange.Copy .Range("A1")
    LastLig = .Cells(.Rows.Count, 1).End(xlUp).Row
    .Columns(1).Insert
    .Range("C1") = "X"
    With .Range("A1:A" & LastLig)
        .FormulaR1C1 = "=LEFT(RC[1],3)"
        .Value = .Value
    End With
    .Range("A1:F" & LastLig).Subtotal GroupBy:=1, Function:=xlSum, _
                                      TotalList:=Array(5, 6), Replace:=True, PageBreaks:=False, _
                                      SummaryBelowData:=True
    Selection.ClearOutline
End With
End Sub