Rassembler des données sur plusieurs lignes en une seule

Bonjour à vous,

Je voudrais savoir s'il est possible de récupérer des données qui sont sur plusieurs lignes en une seule afin de regrouper les informations.

Suivant l'image ci-dessous:

J'ai le résultat de mes recherches (dans la partie gauche) et ce que je souhaite après (en partie droit)

snag 23371043
11pour-forum.xlsm (20.96 Ko)

Merci d'avance !

Bonjour Alex, bonjour le forum,

Le code :

Option Explicit 'oblige à déclarer toutes les variables
Private O As Worksheet 'déclare la variable O (Onglet)

Sub Macro1()
Set O = Worksheets("Feuil1") 'définit l'onglet O
O.Range("H1").CurrentRegion.Offset(2, 0).ClearContents 'efface les anciennes données
End Sub

Sub Macro2()
Dim TV As Variant 'déclare la variable TV (Tableau des Valeurs)
Dim D As Object 'déclare la variable D (Dictionnaire)
Dim I As Integer 'déclare la variable I (Incrément)
Dim J As Integer 'déclare la variable J (incrément)
Dim TMP As Variant 'déclare la variable TMP (tableau TeMPoraire)
Dim R As String 'déclare la variable R (Résultat)
Dim DEST As Range 'déclare la variable DEST (cellule de DESTination)

Set O = Worksheets("Feuil1") 'définit l'onglet O
O.Range("H1").CurrentRegion.Offset(2, 0).ClearContents 'efface les anciennes données
TV = O.Range("A1").CurrentRegion 'définit le tableau des valeurs TV
Set D = CreateObject("Scripting.Dictionary") 'définit le dictionnaire D
For I = 3 To UBound(TV, 1) 'boucle sur toutes les lignes I du tableau des valeurs TV (en partant de la troisième)
    D(TV(I, 1)) = "" 'alimente le dictionnaire D avec les données en colonne 1 de TV
Next I 'prochaine ligne de la boucle
TMP = D.Keys 'récupère dans le tableau temporaire TMP la liste des éléments du dictionnaire D sans doublon (les clés)
For J = 0 To UBound(TMP) 'boucle 1 : sur tous les éléments J du tableau temporaire TMP
    R = "" 'initialise le résultat R
    For I = 3 To UBound(TV, 1) 'boucle 2 : sur toutes les lignes I du tableau des valeurs TV (en partant de la troisième)
        If TV(I, 1) = TMP(J) Then 'condition : si la donnée ligne I colonne 1 de TV est égale à l'élément J de TMP
            R = IIf(R = "", TMP(J) & " avec (" & TV(I, 3), R & " &  " & TV(I, 3)) 'définit le résultat R
        End If 'fin de la condition
    Next I 'prochaine ligne dela boucle
    R = R & ")" 'finalise le résultat R en fermant la parenthèse)
    Set DEST = O.Cells(Application.Rows.Count, "H").End(xlUp).Offset(1, 0) 'définit la cellule de destination DEST
    DEST.Value = R 'renvoie le résultat R dans DEST
Next J 'prochain élément de la boucle 1
End Sub

Affecte la Macro1 au bouton Effacer te la Macro2 au bouton Macro...

You are the BEST !

Merci beaucoup !

Re,

Juste une Bestiole. Ça suffira ...

Rechercher des sujets similaires à "rassembler donnees lignes seule"