XL 2019 création macro : remplissage automatique tableau à partir de données

[alorent]

Bonjour à tous,
Voici un exemple avec données factices pour expliquer mon prb :

	Variable 1	Variable 2	Variable 3
Individu 1	6	10
Individu 2	20		3

J'aimerais obtenir grâce à une macro j'imagine :

	Variable en première position	Variable en deuxième position	Variable en troisième position
Individu 1	Variable 2	Variable 1	Variable 3
Individu 2	Variable 1	Variable 3	Variable 2

Je le fais avec des formules excel jusqu'ici mais c'est long, j'ai bcp de lignes... Pourriez-vous m'aider s'il vous plait ?

 

[sylvanu]

Bonjour Alorent,
Même avec beaucoup de lignes, cela peut être rapide, avec :

=SIERREUR(INDEX($B$1:$D$1;EQUIV(GRANDE.VALEUR($B2:$D2;J$1);$B2:$D2;0));"")

Essayez avec cette PJ de 1000 lignes. Quand vous modifiez un nombre l'actualisation est immédiate.
Le tableau d'entrée est en feuille Entrée, la sortie en ... Sortie.
La nécessité de recopier le tableau est d'éviter les exæquo avec l'ajout d'un petit offset sur chaque valeur.

 

[alorent]

Ok merci beaucoup ! je vais tester cela 🙂

 

[sylvanu]

For the fun ! 🙂
Une version VBA. Ne nécessite pas de colonnes supplémentaires.
Temps de traitement sur mon PC pour 1000 lignes 70ms. Ce qui me semble acceptable.

Sub Transfert()
Dim DL%, L%, i%, j%, tablo(), tablo2(), Nom(), T0
T0 = Timer
Application.ScreenUpdating = False
DL = Range("A65500").End(xlUp).Row
tablo = Range("A1:D" & DL)
ReDim tablo2(DL, 3)
ReDim Nom(4)
For L = 2 To UBound(tablo)
    Nom(2) = Cells(1, 2): Nom(3) = Cells(1, 3): Nom(4) = Cells(1, 4)
    For i = 2 To 4
        For j = 2 To 4
            If tablo(L, i) > tablo(L, j) Then
                buffer1 = tablo(L, j): buffer2 = Nom(j)
                tablo(L, j) = tablo(L, i): Nom(j) = Nom(i)
                tablo(L, i) = buffer1: Nom(i) = buffer2
            End If
        Next j
    Next i
    tablo2(L - 2, 0) = tablo(L, 1)
    For i = 1 To 3
        tablo2(L - 2, i) = Nom(i + 1)
    Next i
Next L
Range("$F$2").Resize(DL, 4) = tablo2
[E4] = "Temps de transfert : " & Round(1000 * (Timer - T0)) & "ms."
End Sub