Excel - Une macro pour combiner les lignes sélectionnées

Problème

J'ai des données source dans Excel ressemblant à ceci:

CustomerID SalesMonth SalesAmount

 12345 janvier 150 12345 mars 100 12345 avril 200 56789 janvier 800 56789 10 mai 78945 20 novembre 44444 janvier 1000 .... 

La combinaison de CustomerID et SalesMonth est unique.

Et j'aimerais combiner les données source dans un autre onglet Excel, sous la forme suivante:

Identifiant client 1er mois 1er nombre 2e mois mois 2e nombre 3e mois 3e nombre

 12345 janv. 150 mars 100 avril 200 56789 janv. 800 10 mai 78945 20 nov. 44444 janv. 1000 

Au total, il peut y avoir jusqu'à 10 mois différents pour un client (certains n'en ont qu'un ou deux). L'important est qu'il n'y ait pas de "lacunes" dans les lignes de sortie, par exemple si un client n'a vendu que le mois de novembre, la cellule "1er mois" doit alors indiquer "Nov" pour ce client.

Solution

Essayez cette macro et consultez la feuille 2 (copiez les données de la feuille 1 à la feuille 3 par mesure de sécurité)

 Sous test () Dim client As Range, ddata () As Range, custunq As Range, cunq As Range, filt As Range Dim dest As Range, j As long, k As long avec des feuilles de calcul ("sheet1") Définissez customer = Range ( .Range ("A1"), .Range ("A1"). End (xlDown)) Définissez custunq = .Range ("A1"). End (xlDown) .Offset (5, 0) customer.AdvancedFilter xlFilterCopy,, custunq, True Set custunq = Plage (custunq.Offset (1, 0), custunq.End (xlDown)) pour chaque custunq de custunq. Range ("A1"). CurrentRegion.AutoFilter: = 1, Critère1: = custunq.Value Définissez filt = .Range ("A1"). CurrentRegion.Offset (1, 0) .Resize (Rows.Count - 1, Columns.Count). _ SpecialCells (xlCellTypeVisible) j = WorksheetFunction.CountA (filt.Columns (1)) 'MsgBox j ReDim ddata (1 à j) avec des feuilles de calcul ("sheet2") Définissez dest = .Cells (Rows.Count, "A"). End (xlUp) .Offset (1, 0) dest = filt (1, 1) End With Avec pour k = 1 To j Définir ddata (k) = .Range (filt (k, 2), filt (k, 3)) ddata (k) .Copier avec des feuilles de calcul ("sheet2") .Cells (dest.Row, Columns.Count) .End (xlToLeft) .Offset (0, 1) .PasteSpecial End With Next k .Range ("A1"). CurrentRegion.AutoFilter Next custunq Range (.Range ("a1"). End (xlDown) .Offset (1, 0), .Cells (Rows.Count, "A"). End (xlUp)). EntireRow.Delete End With End Sub Sub undo () Worksheets ("sheet2"). Cells.Clear End Sub 

Merci à Venkat1926 pour cette astuce.