XL 2016 Transposer certains groupe de colonnes en ligne VBA

[joaoratao]

Bonjour à tous

Avant toute chose je suis débutant en VBA mais c'est en forgeant que l'on devient forgerons !

J'ai un fichier issu de résultats d'un questionnaire que je cherche à structurer afin de pouvoir l'utiliser en BdD

Il s'agit d'une transposition mais par groupe de colonnes. Pour mieux comprendre je pense que le fichier en annexe doit faire l'affaire.

Il faut noter que les groupes de colonne sont variables c'est à dire qu'une ligne peux avoir l'info de jusqu'à 5 enfants. Dans l'exemple la struture du groupe à transposer est fixe mais j'ai un autre ficher ou cette structure peut être variable.

Pour compliquer le tout, du moins pour moi, il n'y a pas toujours de l'info pour les conjoints (Cf exemple)

J'ai essayé de jouer avec l'info de la discussion ci dessous mais je pense que je suis trop débutant pour maîtriser les modifications nécessaires

Transposer certaine colonne en ligne VBA

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...

www.excel-downloads.com

Cette solution de vgendron est celle que j'ai essayé de travailler sans grands résultats
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

Votre aide sera fortement appréciée

Merci beaucoup par avance

 

[fanfan38]

Bonjour
Ci joint ma solution
A+ François

 

[joaoratao]

Merci beaucoup François.

Cela marche du tonnerre ! Et ta rapidité de réponse m'a beaucoup surpris

Pour assouvir ma curiosité, comment puis je avoir accès à la macro? Je ne la retrouve pas sur l'onglet macro où j'ai l'habitude de retrouver les macro. Cela me permettra de voir comment tu a fait et d'essayer de comprendre --> Progresser
(j'ai trouvé à force de chercher - Maintenant j'essaye de comprendre! )

Pour monter la parade, je cherche aussi la solution pour un fichier similaire mais avec des sous groupes dont la structure n'est pas constante.

Encore une fois merci beaucoup. Au plaisir de te lire

 

[fanfan38]

La macro est sur la feuille
cliquer sur l'onglet Folha1 avec le bouton droit de la souris
et choisir visualiser le code
A+ François

 

[joaoratao]

Bonsoir

Suite a la proposition de François, j'ai utiliser sur le fichier et cela marche très bien.

Par contre j'ai d'autres fichiers dans la même logique et je cherche à adapter la macro mais je n'y suis pas arrivé

Je suis trop débutant

Voilà ce que j'ai fait. Quelqu'un peut il m'aider a comprendre comment je fait jouer sur les variables pour pouvoir adapter à n'importe quel fichier?

Private Sub CommandButton1_Click() 'transfert
Dim i As Long, derlig As Long, k As Integer, lig As Long, dercol As Integer
Dim j As Integer
derlig = Range("A" & Rows.Count).End(xlUp).Row
dercol = Cells(1, Columns.Count).End(xlToLeft).Column
lig = 1
Sheets("Resultat").Range("A2:q5000").ClearContents
For i = 2 To derlig
For k = 6 To dercol Step 16
If Len(Cells(i, k).Value) > 0 Then
lig = lig + 1
Sheets("Resultat").Range("A" & lig).Value = Range("A" & i).Value
Sheets("Resultat").Range("B" & lig).Value = Range("B" & i).Value
Sheets("Resultat").Range("C" & lig).Value = Range("C" & i).Value
Sheets("Resultat").Range("D" & lig).Value = Range("D" & i).Value
Sheets("Resultat").Range("E" & lig).Value = Range("E" & i).Value
For j = 0 To 12
Sheets("Resultat").Cells(lig, j + 5).Value = Cells(i, k + j).Value
Next j
End If
Next k
Next i
End Sub

Je remet un fichier .

Pourriez vous dans l'explication être un peu professoral. Je cherche a comprendre ce que je fait mal.

Merci une fois de plus de votre aide à tous

 

[fanfan38]

Bonjour

Private Sub CommandButton1_Click() 'transfert
'déclaration des nariables
Dim i As Long, derlig As Long, k As Integer, lig As Long, dercol As Integer
Dim j As Integer

derlig = Range("A" & Rows.Count).End(xlUp).Row 'dernière ligne
dercol = Cells(1, Columns.Count).End(xlToLeft).Column 'dernière colonne
lig = 1 'initialisation de la valeur
Sheets("Resultat").Range("A2:q5000").ClearContents 'effacement des données
For i = 2 To derlig 'boucle sur les lignes
For k = 6 To dercol Step 16 'boucle sur les colonnes  à partir de la colonne 6 avec un pas de 16?
'c'est à dire qu'il y a 15 colonnes par personne
If Len(Cells(i, k).Value) > 0 Then ' si la cellule(ligne, colonne) n'est pas vide
lig = lig + 1 'recopie à la ligne suivante les données des 5 premières colonnes
Sheets("Resultat").Range("A" & lig).Value = Range("A" & i).Value
Sheets("Resultat").Range("B" & lig).Value = Range("B" & i).Value
Sheets("Resultat").Range("C" & lig).Value = Range("C" & i).Value
Sheets("Resultat").Range("D" & lig).Value = Range("D" & i).Value
Sheets("Resultat").Range("E" & lig).Value = Range("E" & i).Value
For j = 0 To 12 'recopie les 13 cellules concernées (or au dessus tu as mis 15?)
Sheets("Resultat").Cells(lig, j + 5).Value = Cells(i, k + j).Value
Next j
End If
Next k
Next i
End Sub

A+ François

 

[Staple1600]

Bonjour le fil, joaratao, fanfan38

Une suggestion d’allègement (en ces temps de confinement, c'est un doux mot à entendre )
On peut remplacer ces cinq lignes par une seule

Sheets("Resultat").Range("A" & lig).Value = Range("A" & i).Value
Sheets("Resultat").Range("B" & lig).Value = Range("B" & i).Value
Sheets("Resultat").Range("C" & lig).Value = Range("C" & i).Value
Sheets("Resultat").Range("D" & lig).Value = Range("D" & i).Value
Sheets("Resultat").Range("E" & lig).Value = Range("E" & i).Value

La suggestion de remplacement
Sheets("Resultat").Cells(lig, 1).Resize(, 5) = Cells(i, 1).Resize(, 5).Value

PS: Ce n'est ni mieux, ni moins bien. C'est juste ma suggestion.
C'est comme cela que je l'écrirai.

 

[joaoratao]

Merci Staple 1600 et Fanfan 38.

Ça avance ! Doucement mais ça avance !

J'ai compris la plus part des différentes lignes de commandes de François. J'ai repris ta suggestion JM pour me faciliter la lecture.

Tout va bien sur la première ligne mais dès la deuxième ligne dès la 6ème colonne je constate un décalage que je n'arrive pas à comprendre.

Je sûr que je suis pas loin ! Mais j'ai besoin de votre aide pour finir ce fichier. Vos explications sont plus que bien venues pour que je comprenne mes erreurs et puisse ainsi m'améliorer

J'ajoute le fichier pour que vous puissiez comprendre et éventuellement corriger le fichier.

Merci à tous-

Private Sub CommandButton1_Click() 'transfert
'déclaration des variables
Dim i As Long, derlig As Long, k As Integer, lig As Long, dercol As Integer
Dim j As Integer

derlig = Range("A" & Rows.Count).End(xlUp).Row 'dernière ligne
dercol = Cells(1, Columns.Count).End(xlToLeft).Column 'dernière colonne
lig = 1 'initialisation de la valeur

Sheets("Resultat").Range("A2:u15000").ClearContents 'effacement des données

For i = 2 To derlig 'boucle sur les lignes
For k = 6 To dercol Step 17 'boucle sur les colonnes à partir de la colonne 6 avec un pas de 17?
'c'est à dire qu'il y a 16 colonnes par personne

If Len(Cells(i, k).Value) > 0 Then ' si la cellule(ligne, colonne) n'est pas vide

lig = lig + 1 'recopie à la ligne suivante les données des 5 premières colonnes

Sheets("Resultat").Cells(lig, 1).Resize(, 5) = Cells(i, 1).Resize(, 5).Value

For j = 0 To 15 'recopie les 16 cellules concernées
Sheets("Resultat").Cells(lig, j + 6).Value = Cells(i, k + j).Value
Next j
End If
Next k
Next i
End Sub

 

[fanfan38]

L'erreur est là
For k = 6 To dercol Step 17 'boucle sur les colonnes à partir de la colonne 6 avec un pas de 17?
c'est moi qui ai dû te dire des conneries. il y a 16 colonnes donc
For k = 6 To dercol Step 16 'pour aller de la colonne 6 à 22

A+ François

 

[joaoratao]

Merci à tout le fil. La solution semble trouvée.

Je rajoute le fichier avec la version finale