Sub Macro1()
Dim O As Worksheet 'déclare la variable O (Onglet)
Dim TS As ListObject 'déclare la variable TS (Tableau Structuré)
Dim TV As Variant 'déclare la variable TV (Tableau des Valeurs)
Dim D As Object 'déclare la variable D (Dictionnaire)
Dim TMP As Variant 'déclare la variable TMP (tableau TeMPoraire)
Dim I As Integer 'déclare la variable I (Incrément)
Dim J As Integer 'déclare la variable J (incrément)
Dim K As Integer 'déclare la variable K (incrément)
Dim L As Integer 'déclare la variable L (incrément)
Dim TC() As Variant 'déclare la variable TC (Tableau des Critères)
Dim TL() As Variant 'déclare la variable TL (Tableau des Lignes)
Dim T As String 'déclare la variable T (Texte)
Set O = Worksheets("Données") 'définit l'onglet O
Set TS = O.ListObjects("Tableau1") 'définit le tableau structuré TS
TV = TS.DataBodyRange 'définit le tableau des valeurs TV
Set D = CreateObject("Scripting.Dictionary") 'définit le dictionnaire D
For I = 1 To UBound(TV, 1) 'boucle sur toutes les lignes I du tableau des valeurs TV
D(TV(I, 3)) = "" 'alimente le dictionnaire Davec les données en colonne 3 (DPD Principal)
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 doublons (les clé)
'on a récupérés les "DPD Pricipal" sans doublon
ReDim Preserve TC(0 To UBound(TMP)) 'redimensionne le tableau des critères CT (autant de lignes que TMP)
For J = 0 To UBound(TMP) 'boucle 1 : sur tous les éléments du tableau temporaire TMP
Set D = Nothing 'vide le dictionnaire D
Set D = CreateObject("Scripting.Dictionary") 'définit le dictionnaire D
For I = 1 To UBound(TV, 1) 'boucle 2 : sur toutes les lignes I du tableau des valeurs TV
If TV(I, 3) = TMP(J) Then 'condition : si la donnée ligne I colonne 3 de TV est égale à TMP(J)
D(TV(I, 1)) = "" 'alimente le dictionnaire D avec les données en colonne 1 de TV (CODEUT)
End If 'fin de la condition
Next I 'prochaine ligne de la boucle
TC(J) = D.keys 'recupère dans le tableau TC(J), la listes des élément du dictionnaire D sans doublons (les clé)
Next J 'prochain élément du tableau temporaire TMP
'on a pour chaque 'DPD Principal" un tableau des critères avec leurs CODEUT sans doublon
For J = 0 To UBound(TMP) 'boucle 1 : sur tous les éléments J du tableau temporaire TMP (les "DPD Principal")
K = K + 1 'incrémente K
ReDim Preserve TL(1 To K) 'redimentionne le tableau des Lignes TL (K lignes)
TL(K) = TMP(J) 'récupère dans la ligne K de TL le DPD Principal TMP(J)
For L = 0 To UBound(TC(J)) 'boucle 2 : sur tous les citères L du tableau des critères TC
For I = 1 To UBound(TV, 1) 'boucle 3 sur toutes les lignes I du tableau des valeurs TV
If TV(I, 3) = TMP(J) Then 'condition : si la donnée ligne I colonne 3 de TV est égale à l'élément j de TMP
'si la donnée ligne I colonne 1 de TV est égale au critère L du tableau des critères TC(J)
'le texte T est égal à T suivie de la donnée ligne I colonne 2 de TV
If TV(I, 1) = TC(J)(L) Then T = T & TV(I, 2)
End If 'fin de la condition
Next I 'prochaine ligne de la boucle 3
K = K + 1 'incrémente K
ReDim Preserve TL(1 To K) 'redimensionne le tableau des lignes TL (K lignes)
'récupère dans la ligne K de TL, le critères L tu tableau des critères TC(J), suivi du texte T, suivi de la date principale, suivi de DPD principal
TL(K) = TC(J)(L) & T & "_" & TV(1, 5) & "_" & TMP(J)
T = "" 'vide le texte T
Next L 'prochain critère de la boucle 2
Next J 'prochaine élément du tableau temporaire TMP
'si K est supérieure à zéro, renvoie le tableau trsposé Tl dans la cellule H34 redimensionnée (tu adapteras l'adresse de la cellule)
If K > 0 Then Range("H34").Resize(K).Value = Application.Transpose(TL)
End Sub
