Transposer certaines lignes d'un fichier en colonne

11help.xlsx (15.74 Ko)

Bonjour,

J essaie en vain de coder 1 macro ! quelle galère...

Dans le fichier Excel reçu, les informations sont disposées en ligne, et ces informations sont attendues en colonne.

voici les infos reçues :

Produit Caractéristique1 Caractéristique2 Couleur Nombre

référence 1 crayon feutre Rouge 3

référence 1 crayon feutre Vert 2

référence 2 crayon papier Jaune 2

référence 2 crayon papier Noir 3

et la disposition attendue :

Produit Caractéristique1 Caractéristique2 Rouge Vert Bleu Rose Jaune Noir Blanc Violet

référence 1 crayon feutre 3 2

référence 2 crayon papier 2 3

L'entête résultat est figée = le rouge est toujours assigné à la colonne D, le vert la E...

Et dans le fichier résultat la référence 1 ne doit figurer qu'une fois..

Le tableau résultat pourrait être créé idéalement sur une deuxième feuille.

Pourriez-vous m'aider svp ?!

Bonjour et bienvenue,

Une proposition réalisée avec Récupérer et transformer (Power Query) intégré à ta version Excel.

Pour actualiser les données : Ruban, Données et Actualiser tout.

Cdlt.

19help.xlsx (20.13 Ko)

Bonjour ! Merci pour ta réponse ! Désolée je ne l'avais pas vue !! (Ca marche donc quand on poste une demande !) Je n'arrive pas à afficher le code, mais c'est bien ce que j essaie de faire. Je ne connais pas du tout power query, il faut que je me renseigne

Bonjour _avenueB, Jean-Eric

Essaie ceci :

Option Explicit
Sub test()
    Dim a, b(), i As Long, dico1 As Object, dico2 As Object, txt As String
    Set dico1 = CreateObject("Scripting.Dictionary")
    dico1.comparemode = 1
    Set dico2 = CreateObject("Scripting.Dictionary")
    dico2.comparemode = 1
    a = Sheets("Initial").Cells(1).CurrentRegion.Value
    For i = 2 To UBound(a, 1)
        If Not dico1.exists(a(i, 4)) Then
            dico1(a(i, 4)) = dico1.Count + 4
        End If
    Next
    ReDim b(1 To UBound(a, 1), 1 To dico1.Count + 3)
    b(1, 1) = a(1, 1): b(1, 2) = a(1, 2): b(1, 3) = a(1, 3)
    For i = 0 To dico1.Count - 1
        b(1, i + 4) = dico1.keys()(i)
    Next
    For i = 2 To UBound(a, 1)
        txt = Join(Array(a(i, 1), a(i, 2), a(i, 3)), Chr(2))
        If Not dico2.exists(txt) Then
            dico2(txt) = dico2.Count + 2
            b(dico2(txt), 1) = a(i, 1)
            b(dico2(txt), 2) = a(i, 2)
            b(dico2(txt), 3) = a(i, 3)
        End If
        b(dico2(txt), dico1(a(i, 4))) = a(i, 5)
    Next
    Application.ScreenUpdating = False
    With Sheets.Add().[a1].Resize(dico2.Count + 1, dico1.Count + 3)
        With .Rows(1)
            .Borders.Weight = 2
            .Interior.ColorIndex = 15
            .Font.Bold = True
            .HorizontalAlignment = xlCenter
        End With
        .Value = b
        .Borders.Weight = 2: .Columns.AutoFit
    End With
    Application.ScreenUpdating = True
    Set dico1 = Nothing: Set dico2 = Nothing
End Sub

Attention aux espaces parasites en fin de chaîne dans la colonne couleur.

klin89

Merci Klin89 ! c'est parfait

je peux utiliser le code

en revanche je rencontre maintenant un problème de performance

car en fait j'ai 230 colonnes et les lignes peuvent aller jusqu'a 240000 voire +...

je me demande si power query pourrait apporter une solution

?

sinon la macro fait le job :) et le probleme est réglé

et meme à 240000 lignes le résultat sort apres 6 minutes...

(c'est que les utilisateurs vont devoir se passer d'un fichier qu ils avaient directement auparavant...)

Re _avenueB,

Enlève la mise en forme et teste avec ceci :

With Sheets.Add().[a1].Resize(dico2.Count + 1, dico1.Count + 3)
   .Value = b
End With

Ça me paraît bien long

230 colonnes restituées ou 230 colonnes dans la feuille source ? Je ne comprends pas.

Envoie un nouveau fichier représentatif.

klin89

Rechercher des sujets similaires à "transposer certaines lignes fichier colonne"