Transposer certaine colonne en ligne VBA

[Mauro]

Bonjour à tous🙂,
Je cherche a créer une base de donnée exploitable pour pouvoir générer des TCD. Sauf que dans la base de donnée que j'ai à disposition j'ai plusieurs colonne "nom dates" que je cherche à mettre sous forme de ligne. Certaines colonnes doivent aussi rester sous forme de colonne.
tout mes noms de colonne date de date vont commencer par "Day" + nom du mois
je vous ai fait un petit montage et j'ai mis l'exemple de fichier excel en ci-joint (avec un morceau de VBA que j'ai essayé de faire).



Je vous remercie pour votre aide!🙂

 

[vgendron]

Bonjour

Va voir dans ce post qui avait une demande similaire: transformer des colonnes en lignes.....
https://www.excel-downloads.com/thr...eau-a-double-entree-en-liste-en-vba.20027765/

à comprendre et adapter à ton besoin

PS: des images ne nous servent à rien...

 

[Mauro]

Je viens de voir c'est globalement ce que je veux faire 🙂.
Mais étant débutant en VBA j'ai du mal à adapter le code.
Par exemple comment je fais pour qu'il ignore certaines colonnes et qu'ils les duplique comme la colonne A?

Merci!

 

[Mauro]

le code VBA

Sub Tab1toTab2()
Dim tabInit() As Variant
Dim tabFinal() As Variant

With Sheets("Data")
    FeuilleDest = .Range("A1") ' la feuille de destination est indiquée dans la cellule A1
    'on détecte les données du tableau à exporter
    NbLignes = .Range("A" & .Rows.Count).End(xlUp).Row - 1 'nb de lignes du tableau initial
    NbCol = .Range("A2").End(xlToRight).Column 'nb de colonnes
    tabInit = .Range("A2").Resize(NbLignes, NbCol).Value
    taille = (UBound(tabInit, 1) - 1) * (UBound(tabInit, 2) - 1) 'calcul du nombre de lignes du tableau final
    ReDim tabFinal(1 To taille, 1 To 3) 'on définit les dimensions du tableau final
    j = 1
    For i = 2 To UBound(tabInit, 1) 'on commence à la ligne 2 du tableau pour ignorer la ligne d'entete
        For k = LBound(tabInit, 2) + 1 To UBound(tabInit, 2) 'pour chaque colonne du tableau
            tabFinal(j, 1) = tabInit(i, 1)
            tabFinal(j, 2) = tabInit(1, k)
            tabFinal(j, 3) = tabInit(i, k)
            j = j + 1
        Next k
      
    Next i
End With

With Sheets("RES") 'dans la feuille de destination (première cellule du tabInit)
    .UsedRange.Offset(1, 0).ClearContents 'on efface juste le contenu des cellules
    .Range("A2").Resize(UBound(tabFinal, 1), UBound(tabFinal, 2)) = tabFinal
End With
End Sub

 

[vgendron]

il faut ton fichier exemple...
et poster le code que j'ai déjà écrit et qu'il faudra modifier pour ton cas.. ne sert à rien..

et quelles colonnes ignores tu ??

 

[Mauro]

Merci de ta réponse! Oups oui, voici un exemple du type de fichier que je veux avoir!
en fait je veux conserver ("ignorer") un certains nombres de colonne de détail, et faire en sorte qu'elle soit dupliquer (avec le nom) en fonction de si j'ai des colonne date (je peux en avoir 3 comme 50), pour faire un tableau dans lequel ça me donne:
Personne1 -- detail 1 -- date1 -- cout1
Personne1 -- detail 1 -- date2 -- cout2
Personne1 -- detail 1 -- date3 -- cout3
Merci beaucoup

 

[vgendron]

un début de réponse ici

Sub Tab1toTab2()
Dim tabInit() As Variant
Dim tabFinal() As Variant
With Sheets("Feuil1")
    'FeuilleDest = .Range("A1") ' la feuille de destination est indiquée dans la cellule A1
    'on détecte les données du tableau à exporter
    NbLignes = .Range("A" & .Rows.Count).End(xlUp).Row  'nb de lignes du tableau initial
    NbCol = .Range("A2").End(xlToRight).Column 'nb de colonnes
    tabInit = .Range("A1").Resize(NbLignes, NbCol).Value
   
   
    taille = (UBound(tabInit, 1) - 1) * (UBound(tabInit, 2) - 2) 'calcul du nombre de lignes du tableau final
    ReDim tabFinal(1 To taille, 1 To 4) 'on définit les dimensions du tableau final
    j = 1 'numéro de ligne du tablo en cours de remplissage
    For i = 2 To UBound(tabInit, 1) 'on commence à la ligne 2 du tableau pour ignorer la ligne d'entete
        For k = LBound(tabInit, 2) + 1 To UBound(tabInit, 2) - 1 'pour chaque colonne du tableau
            tabFinal(j, 1) = tabInit(i, 1)
            tabFinal(j, 2) = tabInit(i, 2)
            tabFinal(j, 3) = tabInit(1, k + 1)
            tabFinal(j, 4) = tabInit(i, k + 1)
           
            j = j + 1
        Next k
       
    Next i
End With
With Sheets("Feuil3") 'dans la feuille de destination (première cellule du tabInit)
    .UsedRange.Offset(1, 0).ClearContents 'on efface juste le contenu des cellules
    .Range("A2").Resize(UBound(tabFinal, 1), UBound(tabFinal, 2)) = tabFinal
End With
End Sub

 

[vgendron]

et pour la conversion en date de la colonne 3
suffit de supprimer le mot '"DAY" et excel transforme le reste directement en date format Mois - année

Sub Tab1toTab2()
Dim tabInit() As Variant
Dim tabFinal() As Variant
With Sheets("Feuil1")
    'FeuilleDest = .Range("A1") ' la feuille de destination est indiquée dans la cellule A1
    'on détecte les données du tableau à exporter
    NbLignes = .Range("A" & .Rows.Count).End(xlUp).Row  'nb de lignes du tableau initial
    NbCol = .Range("A2").End(xlToRight).Column 'nb de colonnes
    tabInit = .Range("A1").Resize(NbLignes, NbCol).Value
End With
   
    taille = (UBound(tabInit, 1) - 1) * (UBound(tabInit, 2) - 2) 'calcul du nombre de lignes du tableau final
    ReDim tabFinal(1 To taille, 1 To 4) 'on définit les dimensions du tableau final
    j = 1 'numéro de ligne du tablo en cours de remplissage
    For i = 2 To UBound(tabInit, 1) 'on commence à la ligne 2 du tableau pour ignorer la ligne d'entete
        For k = LBound(tabInit, 2) + 1 To UBound(tabInit, 2) - 1 'pour chaque colonne du tableau
            tabFinal(j, 1) = tabInit(i, 1)
            tabFinal(j, 2) = tabInit(i, 2)
            tabFinal(j, 3) = tabInit(1, k + 1)
            tabFinal(j, 4) = tabInit(i, k + 1)
            j = j + 1
        Next k
    Next i
    For i = LBound(tabFinal, 1) To UBound(tabFinal, 1)
        tabFinal(i, 3) = WorksheetFunction.Substitute(tabFinal(i, 3), "Day", "")
    Next i

With Sheets("Feuil3") 'dans la feuille de destination (première cellule du tabInit)
    .UsedRange.Offset(1, 0).ClearContents 'on efface juste le contenu des cellules
    .Range("A2").Resize(UBound(tabFinal, 1), UBound(tabFinal, 2)) = tabFinal
End With
End Sub

Note: pour Novembre et décembre.. il faut enlever le 2 et 3 dans le tableau de data

 

[Mauro]

Mais c'est merveilleux!!!!! C'est vraiment génial ! Merci beaucoup!!
Et le Substitute placé comme ça, marche vraiment très bien (j'étais partie sur une boucle à la base)!
J'ai encore une question! si je veux pouvoir sélectionner des colonnes à garder, à supprimer (disparaît dans la tableau final) et celle a convertir en ligne! Tu le ferais comment?

Merci

 

[Mauro]

Salut,
J'ai essayé juste de rajouter des colonnes à ne pas convertir en ligne (comme les colonnes prénom et détail)
Du coup j'ai modifiécette partie là

         tabFinal(j, 1) = tabInit(i, 1)
            tabFinal(j, 2) = tabInit(i, 2)
            tabFinal(j, 3) = tabInit(i, 3)
            tabFinal(j, 4) = tabInit(1, k + 1)
            tabFinal(j, 5) = tabInit(i, k + 1)

et

 ReDim tabFinal(1 To taille, 1 To 5)

Mais sans véritable succès. J'ai des pertes d'informations ou des décalages.
Est ce que tu pourrais m'indiquer les autre ligne a changer ?
Merci beaucoup

 

[vgendron]

Et je suis censé deviner ca comme ca? sans fichier?
et puis. puisque tu dis "ignorer" les nouvelles colonnes... bah. y a rien à faire...

 

[Mauro]

Oups désolé,
J'ai simplifier mon problème voici un exemple de fichier!
Merci 🙂

 

[vgendron]

voici un code qui devrait faire le boulot

à comprendre si tu veux modifier autre chose

Sub Tab1toTab2()
Dim tabInit() As Variant
Dim tabFinal() As Variant
With Sheets("Feuil1")
    'on détecte les données du tableau à exporter
    NbLignes = .Range("A" & .Rows.Count).End(xlUp).Row  'nb de lignes du tableau initial
    NbCol = .Range("A2").End(xlToRight).Column 'nb de colonnes du tableau initial
    tabInit = .Range("A1").Resize(NbLignes, NbCol).Value 'on récupère toutes les infos dans un tablo VBA "TabInit"
End With
   
NbToIgnore = CInt(Application.InputBox("donnez le nombre de colonnes à ""ignorer"" EN PLUS de la première colonne des noms")) 'message pour demander le nombre de colonnes à ignorer (sans compter la première colonne des noms)
'!! les colonnes à transposer DOIVENT OBLIGATOIREMENT ETRE A LA FIN DU TABLEAU
NbToTranspose = NbCol - NbToIgnore - 1 'calcul le nombre de colonnes qui seront donc à transposer
NbLignesFinal = (UBound(tabInit, 1) - 1) * (UBound(tabInit, 2) - NbToIgnore - 1) 'calcul du nombre de lignes du tableau final
ReDim tabFinal(1 To NbLignesFinal, 1 To NbToIgnore + 3) 'on définit les dimensions du tableau final
IndLFinal = 1
IndLInit = 2
x = 1
For IndLFinal = 1 To NbLignesFinal 'on parcourt toutes les lignes du tableau final
    For col = 1 To NbToIgnore + 1 'remplissage des colonnes ignorées
        tabFinal(IndLFinal, col) = tabInit(IndLInit, col)
    Next col
    tabFinal(IndLFinal, NbToIgnore + 2) = WorksheetFunction.Substitute(tabInit(1, col + x - 1), "Day", "") 'on met la date
    tabFinal(IndLFinal, NbToIgnore + 3) = tabInit(IndLInit, col + x - 1) 'et sa quantité
    If x < NbToTranspose Then 'si on a pas encore transposé les NbTOTranspose
        x = x + 1 'on se déplace de 1 vers la droite pour prendre la date suivante au prochain tour
    Else: x = 1 'sinon on revient à la première date
    End If
   
    If IndLFinal Mod NbToTranspose = 0 Then IndLInit = IndLInit + 1 'si on a pas fini de transposer on reste sur la ligne, sinon on prend la suivante
Next IndLFinal
With Sheets("Feuil3") 'dans la feuille de destination (première cellule du tabInit)
    .UsedRange.Offset(1, 0).ClearContents 'on efface juste le contenu des cellules
    .Range("A2").Resize(UBound(tabFinal, 1), UBound(tabFinal, 2)) = tabFinal
End With
End Sub

 

[Mauro]

Bonjour,
Désolé pour le retard je n'arrivais pas à retrouver le flux! ce code est génial!!!
il permet exactement de faire ce que je voulais,
en plus avec les commentaires j'ai compris ton code!
Merci beaucoup!!!