Microsoft 365 Regroupement de cellule avec somme

[bandimalou]

Bonjour à tous et mes meilleurs vœux à tout le monde,

je suis confronté a un problème que je n'arrive pas a résoudre, j'espère que vous pourrez m'aider.
j'ai un fichier Excel (extraction CRM) et j'aimerais rassembler et additionner les colonnes CA et CA-N1 lorsqu'il y a plusieurs lignes avec le même code client.
fichier d'exemple en PJ
j'ai beaucoup de fichiers a faire avec beaucoup de lignes si je pouvais arriver a le faire avec une macro
Merci de votre aide

 

[chris]

Bonjour

Tu veux synthétiser l'ensemble des ficher dans un seul ? Si oui utilise plutôt PowerQuery.

 

[bandimalou]

Bonjour Chris,
non je souhaite regrouper les lignes de client en 1 seul unique mais que chaque cellule avec CA s'additionne avant de supprimer les doublons
merci de m'aider

 

[chris]

RE
Ambigu comme réponse
Si tu veux garder chaque fichier et traiter chaque fichier à part alors c'est effectivement VBA

Les VBistes vont t'aider

 

[bandimalou]

je pense que je me m'exprime mal
chaque fichier est indépendant, mais je souhaite simplement supprimer les doublons présent dans une feuille mais dans le même temps additionner les chiffres de la colonne CA avant de supprimer les doublons.
j'effectuerais la manip sur chaque fichier.
Merci de ton aide Chris

 

[JHA]

Bonjour à tous,

Un début avec Power Query par regroupement

JHA

 

[Franc58]

Bonjour, voici une solution VBA:

Sub TotaliserClients()
    Dim ws As Worksheet
    Dim i As Long
    Dim dict As Object
    Dim Key As Variant
    Dim arr(1) As Double
    
    Set ws = ThisWorkbook.Sheets("Feuil1") 'Changer si besoin
    Set dict = CreateObject("Scripting.Dictionary")
    
    'On démarre à la ligne 2
    For i = 2 To ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
        'Si le code existe dans le dictionnaire, on additionne B et C
        If dict.Exists(ws.Cells(i, "A").Value) Then
            arr(0) = dict(ws.Cells(i, "A").Value)(0) + ws.Cells(i, "B").Value
            arr(1) = dict(ws.Cells(i, "A").Value)(1) + ws.Cells(i, "C").Value
            dict(ws.Cells(i, "A").Value) = arr
        Else
            ' Sinon on ajoute le code au dictionnaire
            arr(0) = ws.Cells(i, "B").Value
            arr(1) = ws.Cells(i, "C").Value
            dict.Add ws.Cells(i, "A").Value, arr
        End If
    Next i
    
    'Effacement plage F2 à H
    ws.Range("F2:H" & ws.Cells(ws.Rows.Count, "F").End(xlUp).Row).ClearContents
    
    'Ecriture totaux
    i = 2
    For Each Key In dict.Keys
        ws.Cells(i, "F").Value = Key
        ws.Cells(i, "G").Value = dict(Key)(0)
        ws.Cells(i, "H").Value = dict(Key)(1)
        i = i + 1
    Next Key
End Sub

 

[chris]

chaque fichier est indépendant, mais je souhaite simplement supprimer les doublons présent dans une feuille mais dans le même temps additionner les chiffres de la colonne CA avant de supprimer les doublons.
j'effectuerais la manip sur chaque fichier.

RE
Un simple TCD fait également cela si on garde la source et le résultat (comme dans toutes les autres solutions données).

Une autre solution VBA qui ne conserve que la synthèse (dans un fichier contenant juste la plage initiale)

Sub Synthese()
    Dim T2 As Range, y As Long, z As Long
    With Worksheets("Feuil1")
        Set Plage = .Range("A1").CurrentRegion
        Plage.Range("A1:C1").Copy Destination:=.Range("E1")
        .ListObjects.Add(xlSrcRange, Plage, , xlYes).Name = "Tableau1"
        y = [Tableau1].ListObject.ListRows.Count
        .Range("E2").Formula2R1C1 = "=UNIQUE(Tableau1[Client])"
        .Range("F2").FormulaR1C1 = "=SUMIFS(Tableau1[CA],Tableau1[Client],RC5)"
        .Range("G2").FormulaR1C1 = "=SUMIFS(Tableau1[CA-N-1],Tableau1[Client],RC5)"
        .Range("F2:G2").AutoFill Destination:=.Range("F2:G" & y)
        .Range("F2:G" & y).Style = "Currency"
        z = .Range("G2").End(xlDown).Row
        Set T2 = .Range("E2:G" & y)
        T2.Copy
        T2.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
        Application.CutCopyMode = False
        .ListObjects.Add(xlSrcRange, T2.Offset(-1).Resize(z), xlYes).Name = "Synthèse"
        [Synthèse].ListObject.TableStyle = "TableStyleLight9"
        .Columns("A:D").Delete Shift:=xlToLeft
    End With
End Sub

 

[bandimalou]

Bonsoir a tous,
Merci a tous pour votre aide, effectivement plusieurs façons de faire mais tout fonctionne bien.
Merci encore JHA,Franc58 et Chris