Microsoft 365 Regroupement de données identiques

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

  • Forum.xlsm
    9.8 KB · Affichages: 14
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…)...

Lolote83

XLDnaute Barbatruc
Bonjour,
Un simple TCD ne ferait-il pas l'affaire ?
1684823845866.png

@+ Lolote83
 

Lolote83

XLDnaute Barbatruc
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

  • Copie de NETPARTY - Requete Power Query.xlsm
    24.9 KB · Affichages: 2

netparty

XLDnaute Occasionnel
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

  • NETPARTY - Requete Power Query.xlsm
    22.3 KB · Affichages: 7

Lolote83

XLDnaute Barbatruc
Re bonjour,
Voici un fichier test avec un tableau structuré.
1) Rajoute des données en ligne, le tableau s'agrandit
2) Rajoute des données en colonne, le tableau s'agrandit
Dis moi
@+ Lolote83
 

Pièces jointes

  • Pour NETPARTY - Tableau structuré.xlsx
    10.2 KB · Affichages: 3

Lolote83

XLDnaute Barbatruc
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
 

netparty

XLDnaute Occasionnel
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
 

Cousinhub

XLDnaute Barbatruc
Bonjour,
Toujours par le biais de Power Query (clic droit dans une cellule de la requête, "Actualiser")
Le résultat dans le 1er onglet
Bonne fin d'apm
 

Pièces jointes

  • Copie de NETPARTY - Requete Power Query-1.xlsm
    25.3 KB · Affichages: 4

Discussions similaires

Statistiques des forums

Discussions
311 725
Messages
2 081 940
Membres
101 845
dernier inscrit
annesof