Microsoft 365 Regroupement de données identiques

  • Initiateur de la discussion Initiateur de la discussion netparty
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

netparty

XLDnaute Occasionnel
Bonjour à tous

Je sollicite votre aide pour une macro en vba.
J'ai dans la feuille IMPORT une série de données que je voudrai regrouper dans la feuille REGROUPEMENT.
J'aimerais que toutes les données soient regroupée par client, une ligne = un client et que les valeurs qui y sont associées soient comptabilisée.

Merci d'avance de votre aide.

Bonne journée à tous
 

Pièces jointes

Solution
Bonsoir à tous,

@cp4 j'avais fait un code du genre y a un moment 😉👍
@netparty Voilà le code en question il est adaptable facilement (Ce code marche sur Mac et PC) :

Le code de base :
Code:
Sub AddOrConcatRemoveDupli() ' Créé par RyuAutodidacte
Dim Sep$, Crit, Col, y As Byte, cLig As New Collection, C As Byte, L&, R&, VA, VR, x

    Sep = "|" ' Le séparateur
    Crit = Array(1) ' Indiquer la ou les colonnes de critères
    '-------------------------
    Col = Array(2, 3, 4) 'Indiquer les colonnes concernées par les sommes ou les concaténations
    Oper = Array("", "", "") 'Pour chaque colonne de Col concernée, mettre "" pour additionner ou mettre caractère de concaténation (ex. : "|" ou bien vbNewLine, etc…)...
Bonjour,
Un simple TCD ne ferait-il pas l'affaire ?
1684823845866.png

@+ Lolote83
 
Re bonjour,
J'ai transformé ton tableau (IMPORT) en tableau structuré.
Puis sur l'onglet REQ, faire clic droit puis actualisé (Requete Power Query)
Lorsque tu auras de nouvelles données, place les dans la tableau structuré, la requête fera le reste.
Cependant, c'est exactement la même chose avec un TCD.
@+ Lolote83
 

Pièces jointes

Re bonjour,
J'ai transformé ton tableau (IMPORT) en tableau structuré.
Puis sur l'onglet REQ, faire clic droit puis actualisé (Requete Power Query)
Lorsque tu auras de nouvelles données, place les dans la tableau structuré, la requête fera le reste.
Cependant, c'est exactement la même chose avec un TCD.
@+ Lolote83
Merci @Lolote83
Et si je veux ajouter des colonnes dans la feuille import comment cela se passe t-il
 

Pièces jointes

Re bonjour,
Si c'est un agrandissement uniquement sur les lignes, la requête PQ doit s'actualiser normalement comme pour le TCD d'ailleurs.
Si par contre, tu as rajoutée des données en colonne et que tu souhaites faire la même chose (somme) sur les nouvelles colonnes, il faut revoir la requête.
Idem pour le TCD, mais peut être plus facile
@+ Lolote83
 
Re-bonjour à tous
Dans l'un de mes ancien fichier j'avais se code qui fonctionnait très bien mais les données étaient en colonne, croyez vous qu'il est possible de l'adapter a mon problème.
Merci d'avance
VB:
Option Explicit

Dim FX As Worksheet, dcol%, nlm&, dlg1&, lg3&, k0%, k1%, k2%

Private Sub Init()
  Dim i%: ActiveWindow.Zoom = 70: Columns.ColumnWidth = 9
  With Columns(1): .ColumnWidth = 56: .HorizontalAlignment = 2: .IndentLevel = 1: End With
  Rows(1).RowHeight = 35.3: Rows(2).RowHeight = 45: [A2] = "Description": Worksheets("CDC").Select
 
  dcol = Cells(3, Columns.Count).End(1).Column: k1 = (dcol - 2) \ 4
  With FX
    For i = 1 To k1 + 1: .Cells(2, i + 1) = "quantité" & vbLf & "fichier " & i: Next i
    i = i + 1: .Cells(2, i) = "total": .Columns(i).ColumnWidth = 7: k0 = k1 + 3
    With .Columns(2).Resize(, k0): .HorizontalAlignment = 4: .IndentLevel = 1: End With
    With .[A1].Resize(, k0): .VerticalAlignment = 2: .HorizontalAlignment = 3: .MergeCells = -1: End With
    With .[A2].Resize(, k0): .VerticalAlignment = 2: .HorizontalAlignment = 3: End With
    .[A1] = "Données après tri": nlm = Rows.Count: dlg1 = Cells(nlm, 1).End(3).Row
    Range("A3:B" & dlg1).Copy: .[A3].PasteSpecial Paste:=xlPasteValues: Application.CutCopyMode = 0: k1 = 3: k2 = 5
  End With
End Sub

Private Sub DispatchCDC()
  Dim Dsc$, Qté As Double, dlg2&, lg2&, lg1&, b As Boolean
  With FX
    Do While Cells(3, k2) <> ""
      dlg2 = Cells(nlm, k2).End(3).Row: lg3 = dlg1
      For lg2 = 3 To dlg2
        Dsc = Cells(lg2, k2)
        If Dsc <> "" Then
          Qté = Cells(lg2, k2 + 1): b = 0
          For lg1 = 3 To dlg1
            If .Cells(lg1, 1) = Dsc Then
              .Cells(lg1, k1) = Qté: b = -1
            End If
          Next lg1
          If b = 0 Then
            lg3 = lg3 + 1
            With .Cells(lg3, 1)
              .Value = Dsc: .Offset(, 1) = 0: .Offset(, k1 - 1) = Qté
            End With
          End If
        End If
      Next lg2
      k1 = k1 + 1: k2 = k2 + 4: dlg1 = lg3
    Loop
    .Select: [A1].Select
  End With
End Sub

Private Sub Val0()
  Dim lg1 As Double, i%
  For lg1 = 3 To lg3
    For i = 3 To k1 - 1
      With Cells(lg1, i)
        If .Value = "" Then .Value = 0
      End With
    Next i
  Next lg1
End Sub

Sub RegroupementCDC()
  On Error GoTo ErrFeuille: Application.ScreenUpdating = 0
  Dim lg1&, b As Byte, dc%: Set FX = Worksheets("RésultatCDC")
  If b = 0 Then Exit Sub 'la feuille "RésultatCDC" existe déjà !
  Call Init: DispatchCDC: Val0
  If lg3 > 3 Then [A3].Resize(lg3 - 2, k0 - 1).Sort [A3], 1
  dc = FX.Cells(2, Columns.Count).End(xlToLeft).Column
  For lg1 = 3 To lg3
    With Cells(lg1, k0)
      .Value = Application.Sum(Cells(lg1, 2).Resize(, dc - 2))
    End With
  Next lg1
  Exit Sub
ErrFeuille:
  Worksheets.Add(, Worksheets(1)).Name = "RésultatCDC"
  b = 1: Resume
End Sub
 
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

Réponses
9
Affichages
326
Retour