Transposer certaine colonne en ligne VBA

Mauro

XLDnaute Nouveau
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!:)
 

Fichiers joints

Dernière édition:

Mauro

XLDnaute Nouveau
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

XLDnaute Nouveau
le code VBA
VB:
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

XLDnaute Barbatruc
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

XLDnaute Nouveau
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
 

Fichiers joints

vgendron

XLDnaute Barbatruc
un début de réponse ici
VB:
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

XLDnaute Barbatruc
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
VB:
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

XLDnaute Nouveau
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

XLDnaute Nouveau
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à
VB:
         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
VB:
 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

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

vgendron

XLDnaute Barbatruc
voici un code qui devrait faire le boulot

à comprendre si tu veux modifier autre chose
VB:
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

XLDnaute Nouveau
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!!!
 

Discussions similaires


Haut Bas