Copier selon les rangs

Bonjour à tous,

j'ai un souci si vous pouvez m'aider (encore hihihi))

j'ai une base qui est une résultat d'enquête, sous chaque libellé est marqué son rang, et je doit faire un table qui va les récupérer en ordre sur les rang convenu.

en bleu la base et en jaune les rangs que chaque libé

llés doivent être entré. en voyant l'exemple ce sera un peu claire

ex: si "Accueil des nouveaux arrivants" a le rang 3 sur la ligne A3, alors il doit être dans la cellule L3 etc...

j'ai fait un VBA a mais ça ne fonctionne pas vraiment. merci pour votre aide

7rang.xlsx (11.31 Ko)

Bonjour à tous;

Une proposition par formule en J3 (à étirer) :

=SIERREUR(INDEX($A$2:$H$2;EQUIV(CTXT(J$1;0;1);$A3:$H3;0));"")

Merci beaucoup, c'est une grande aide.
Mais au fil de l'eau j'aurai beaucoup de base en ligne et en colonne et ce serai mieux de l'automatiser en VBA.
pour l'instant j'utilise votre formule

Bonjour tsydiMiboela, JFL, le fil

Sub AffecterSelonRang()
Dim tabBase()               '   Tableau de la base d'enquête
Dim tabRang()               '   Tableau pour trier la base selon le rang attribué
Dim cptBase, cptRang

    '   Lecture de la base d'enquête
    tabBase = Range(Cells(2, 1), Cells(Cells(Rows.Count, 1).End(xlUp).Row, 8))
    '   Créer le tableau des rangs au même dimensions
    ReDim tabRang(1 To UBound(tabBase, 1), 1 To UBound(tabBase, 2))

    '   Pour chaque ligne de a base /*1
    For cptBase = 2 To UBound(tabBase, 1)
        '   Pour chaque colonne (donc chaque question de l'enquête)
        For cptRang = 1 To UBound(tabBase, 2)
            '   Si la question est renseignée
            If Not (tabBase(cptBase, cptRang) = "") Then
                '   Affecter le le libellé du rang marqué "tabBase(1, cptRang)"
                '   dans le tableau des rang à la position du rang
                '       C'est "tabBase(cptBase, cptRang)" qui contient cette valeur
                '       PS/ J'ai utilisé Val(..) parcce que dans ton fichier les rangs sont indiqués avec un apostrophe (format texte)
                tabRang(cptBase, Val(tabBase(cptBase, cptRang))) = tabBase(1, cptRang)
            End If
        Next
    Next

    '   Il suffit ensuite de copier le tableau des rang
    Cells(2, 10).Resize(UBound(tabRang, 1), UBound(tabRang, 2)) = tabRang

End Sub

'   *1  La boucle commence à la 2ème ligne de la base, pour sauter les libellés

Voici une proposition avec VBA !

Merci beaucoup mon problème a été bien résolut.
encore merci.

Bonne journée à tous et à bien tôt

Bonjour à tous,

Merci beaucoup mon problème a été bien résolut.
encore merci.

Parfait !
Je vous remercie de ce retour.

Bonjour tsydiMiboela, le fil

Merci également à toi tsydiMiboela, pour les remerciements !

Rechercher des sujets similaires à "copier rangs"