Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

XL 2016 Transposer certains groupe de colonnes en ligne VBA

J

joaoratao

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

Pièces jointes

  • aide excel.xlsx
    39.1 KB · Affichages: 8
Solution
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
Trier par date Trier par votes
J

joaoratao

XLDnaute Nouveau
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
 
Dernière édition:
Vote positif 0 Vote négatif
J

joaoratao

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

Pièces jointes

  • testeteste.xlsm
    21.7 KB · Affichages: 5
Vote positif 0 Vote négatif

fanfan38

XLDnaute Barbatruc
Bonjour
VB: 
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
 
Vote positif 0 Vote négatif

Staple1600

XLDnaute Barbatruc
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
VB: 
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.
 
Vote positif 0 Vote négatif
J

joaoratao

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

Pièces jointes

  • testeteste.xlsm
    22.3 KB · Affichages: 7
Dernière édition:
Vote positif 0 Vote négatif

fanfan38

XLDnaute Barbatruc
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
 
Vote positif 0 Vote négatif
Solution
Identifiez-vous ou inscrivez-vous pour participer.

Discussions similaires

N
  • Résolu(e)
Microsoft 365 Mettre la 4ème colonne d'une ListBox au format [h]:mm
3 4 5
Réponses
68
Affichages
1 K
NONO14
N
  • Question
XL 2021 Vos avis SVP: Une fonction TRANSPOSE() à améliorer
16 17 18
Réponses
267
Affichages
4 K
p'tit vieux
R
  • Question
Autres Carré magique de bachet avec vba.
Réponses
2
Affichages
537
kiki29
C
  • Question
Microsoft 365 Transposer des valeurs en 2 colonnes en fonction d'une référence produit
Réponses
9
Affichages
621
Cagnet
C
  • Résolu(e)
XL 2010 Mauvaise utilisation de la fonction InStr
Réponses
11
Affichages
617
jurassic pork
N
  • Question
Microsoft 365 afficher/masquer des lignes en fonction de la valeur d'une cellule qui aura été renseignée par une autre feuille (via un copier/collé automatique)
Réponses
5
Affichages
444
Nel'
N
C
  • Question
XL 2016 VBA Détecter la suppression de la dernière ligne d'un Tableau
Réponses
9
Affichages
441
crocrocro
C
  • Résolu(e)
Autres que penses vous de ce mini test benchmark(timer plus precis)
Réponses
6
Affichages
598
patricktoulon
C
  • Résolu(e)
XL 2016 VBA : inversion de Date sur Range.Resize ... = Tableau après Transpose du Tableau
Réponses
2
Affichages
178
crocrocro
C
  • Question
XL 2021 Dernière ligne rempli d'un tableau de données filtrées
Réponses
5
Affichages
309
treza88
Menu
Connexion
S'inscrire
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…