modification tableau

[Floppy]

Bonjour à tous,

Après avoir arpenté rapidement le forum pour trouver une solution (que j'ai peut être raté, je m'en excuse) je m'en remets à vous.

J'ai un tableau à double entrée classique qui contient en colonne A des matricules et sur la ligne 1 des libellés. Chaque libellé a une valeur différente en fonction du matricule. (onglet 1)
J'aimerai automatiser la "transformation" de ce tableau pour obtenir le résultat obtenu sur l'onglet 2. C'est à dire :
Colonne A : recopier le numéro du matricule autant de fois qu'il y a de libellé (c'est à dire 6)
Colonne B : recopier tous les libellés en face de chaque occurence de matricule
Colonne C : renseigner la valeur correspondant au libellé pour le matricule.

Pour le moment je bricole mais c'est pas pratique, donc si vous avez une idée pour une formule, ou une macro (je suis néophyte complet pour les macros et le VBA...) je suis preneur.

Merci!

Flo

 

[Efgé]

Re : modification tableau

Bonjour Floppy et bienvenu sur le forum

Une proposition par macro.
Pour voir le code : Clic droit sur l'onglet Importation / Visualiser le code.

Private Sub CommandButton1_Click()
Dim i&, J&, L&
Dim T As Variant, Treport As Variant

With Sheets("Tableau initial") ' A Adapter
    T = .Range(.Cells(1, 1), .Cells(.Rows.Count, 1).End(3)(1, 7))
End With

ReDim Treport(1 To UBound(T, 1) * UBound(T, 2), 1 To 3)

For i = LBound(T, 1) + 1 To UBound(T, 1)
    For J = LBound(T, 2) + 1 To UBound(T, 2)
        L = L + 1
        Treport(L, 1) = T(i, 1)
        Treport(L, 2) = T(1, J)
        Treport(L, 3) = T(i, J)
    Next J
Next i

With Sheets("Importation") 'A Adpter
    .UsedRange.ClearContents
    .Cells(2, 1).Resize(L, UBound(Treport, 2)) = Treport
End With
    
End Sub

Cordialement

 

[Floppy]

Re : modification tableau

Bonjour,

Merci infiniment! à la lecture du code ça reste obscur pour moi mais je vais y travailler. En tout cas ca fonctionne à merveille.

Flo

 

[Dranreb]

Re : modification tableau

Bonjour.

Pris de vitesse ! Mais puisque je l'ai fait je le montre :

Mettez ce code dans le module Feuil2 (Tableau a obtenir)

Option Explicit

Private Sub Worksheet_Activate()
Dim Te(), Ts(), Le&, Ce&, Ls&
Te = Feuil1.UsedRange.Value
ReDim Ts(1 To (UBound(Te, 1) - 1) * (UBound(Te, 2) - 1), 1 To 3)
For Le = 2 To UBound(Te, 1)
   For Ce = 2 To UBound(Te, 2)
      Ls = Ls + 1
      Ts(Ls, 1) = Te(Le, 1)
      Ts(Ls, 2) = Te(1, Ce)
      Ts(Ls, 3) = Te(Le, Ce)
      Next Ce, Le
Me.UsedRange.ClearContents ' (Ajouté suite à lecture du code de Efgé)
Me.[A2].Resize(Ls, 3).Value = Ts
End Sub

P.S. Flute ! En plus d'être à la traine, oublié le ClearContents 🙄