Récupérer une liste de nom par colonne selon un critère

Le 09/11/2019 à 14:10

Bonjour à tous,

J'ai besoin de votre aide pour une formule.

J'ai besoin de récupérer dans un fichier une liste de nom.

Dans la colonne A, j'ai une liste de nom

Dans la colonne B, j'ai le niveau

Dans un autre onglet, j'ai besoin de récupérer les noms répartis par niveau sous forme de tableau. Les noms seraient ainsi affichés les uns à la suite des autres et par niveau.

En pièce jointe un fichier, j'espère que c'est assez clair.

Par avance merci pour votre aide,

Masand

33test-v1.xlsx (8.89 Ko)

Le 09/11/2019 à 14:25

Bonjour,

Une solution par TCD

85copy-of-test-v1.xlsx (14.67 Ko)

Le 09/11/2019 à 14:40

Raja a écrit :
Bonjour,
Une solution par TCDCopy of test V1.xlsx

Merci beaucoup pour cette solution, mais j'aurais besoin que les résultats s'affichent dans l'onglet test en colonne.

Masand

Le 09/11/2019 à 14:47

Bonjour le fil, bonjour le forum,

Une proposition VBA :

Sub Macro1()
Dim R As Worksheet 'déclare la variable R (onglet Répartition)
Dim T As Worksheet 'déclare la variable T (onglet Test)
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 TMP As Variant 'déclare la variable TMP (tableau TeMPoraire)
Dim J As Integer 'déclare la variable J (incrément)
Dim TL() As Variant 'déclare la variable TL (Tableau des Lignes)
Dim K As Integer 'déclare la variable K (Incrément)
Dim COL As Byte 'déclare la variable COL (COLonne)

Set R = Worksheets("Répartition") 'définit l'onglet R
Set T = Worksheets("Test") 'définit l'onglet T
T.Range("A2").CurrentRegion.Offset(1, 0).ClearContents 'efface d'éventuelles anciennes données de l'onglet T
TV = R.Range("A2").CurrentRegion 'définit le tableau des valeurs TV
Set D = CreateObject("Scripting.Dictionary") 'définit le dictionnaire D
For I = 2 To UBound(TV, 1) 'boucle sur toutes les lignes I du tableau des valeurs TV (en partant de la seconde)
    D(TV(I, 2)) = "" 'alimente le dictionnaire D avec les données en colonne 2 de TV (le niveau)
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
For J = 0 To UBound(TMP) 'boucle 1 : sur tous les éléments du tableau temporaure TMP
    Erase TL: K = 1 'efface le tableau des lignes TL et réiniatialise la variable K
    For I = 2 To UBound(TV, 1) 'boucle 2 : sur toutes les lignes I du tableau des valeur TV (en partant de la seconde)
        If TV(I, 2) = TMP(J) Then 'condition : si le niveau de la boucle 2 est égale à l'élément de la boucle 1
            ReDim Preserve TL(1 To K) 'redimensionne le tableau des lignes TL (K colonnes)
            TL(K) = TV(I, 1) 'récupère dans la colonne K de TL la donnée en ligne I de TV (=> transposition)
            K = K + 1 'Incrémente K (ajoute une colonne au tableau des lignes TL)
        End If 'fin de la contition
    Next I 'prochaine ligne de la boucle 1
    'définit la colonne COL (recherche la valeur entière du niveau dans la ligne 2 de l'onget T)
    COL = T.Rows(2).Find(TMP(J), , xlValues, xlWhole).Column
    'renvoie dans la cellule redimensionnée ligne 3 colonne COL de l'onglet T le tableau TL transposé
    T.Cells(3, COL).Resize(K - 1, 1).Value = Application.Transpose(TL)
Next J 'prochain élément de la boucle 1
End Sub

Le 09/11/2019 à 14:57

ThauThème a écrit :

Bonjour le fil, bonjour le forum,

Une proposition VBA :

Sub Macro1()
Dim R As Worksheet 'déclare la variable R (onglet Répartition)
Dim T As Worksheet 'déclare la variable T (onglet Test)
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 TMP As Variant 'déclare la variable TMP (tableau TeMPoraire)
Dim J As Integer 'déclare la variable J (incrément)
Dim TL() As Variant 'déclare la variable TL (Tableau des Lignes)
Dim K As Integer 'déclare la variable K (Incrément)
Dim COL As Byte 'déclare la variable COL (COLonne)

Set R = Worksheets("Répartition") 'définit l'onglet R
Set T = Worksheets("Test") 'définit l'onglet T
T.Range("A2").CurrentRegion.Offset(1, 0).ClearContents 'efface d'éventuelles anciennes données de l'onglet T
TV = R.Range("A2").CurrentRegion 'définit le tableau des valeurs TV
Set D = CreateObject("Scripting.Dictionary") 'définit le dictionnaire D
For I = 2 To UBound(TV, 1) 'boucle sur toutes les lignes I du tableau des valeurs TV (en partant de la seconde)
    D(TV(I, 2)) = "" 'alimente le dictionnaire D avec les données en colonne 2 de TV (le niveau)
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
For J = 0 To UBound(TMP) 'boucle 1 : sur tous les éléments du tableau temporaure TMP
    Erase TL: K = 1 'efface le tableau des lignes TL et réiniatialise la variable K
    For I = 2 To UBound(TV, 1) 'boucle 2 : sur toutes les lignes I du tableau des valeur TV (en partant de la seconde)
        If TV(I, 2) = TMP(J) Then 'condition : si le niveau de la boucle 2 est égale à l'élément de la boucle 1
            ReDim Preserve TL(1 To K) 'redimensionne le tableau des lignes TL (K colonnes)
            TL(K) = TV(I, 1) 'récupère dans la colonne K de TL la donnée en ligne I de TV (=> transposition)
            K = K + 1 'Incrémente K (ajoute une colonne au tableau des lignes TL)
        End If 'fin de la contition
    Next I 'prochaine ligne de la boucle 1
    'définit la colonne COL (recherche la valeur entière du niveau dans la ligne 2 de l'onget T)
    COL = T.Rows(2).Find(TMP(J), , xlValues, xlWhole).Column
    'renvoie dans la cellule redimensionnée ligne 3 colonne COL de l'onglet T le tableau TL transposé
    T.Cells(3, COL).Resize(K - 1, 1).Value = Application.Transpose(TL)
Next J 'prochain élément de la boucle 1
End Sub

Merci beaucoup pour le message, je vais essayer mais pas sûre que mon niveau me permette d'arriver au résultat en tout cas je vais tenter ma chance. Si une formule existe, je prends aussi

Masand

Le 09/11/2019 à 15:02