Transposer avec boucle
Oukapaka
Messages postés
112
Date d'inscription
Statut
Membre
Dernière intervention
-
f894009 Messages postés 17277 Date d'inscription Statut Membre Dernière intervention -
f894009 Messages postés 17277 Date d'inscription Statut Membre Dernière intervention -
Bonjour,
J'ai un petit code qu'on a tenté de développer avec mon responsable (on est pas informaticien du tout) et en fait on a une base client sur une seule colonne et pour uploader ça dans notre CRM on veut transformer ça en lignes par client.
En gros :
Nom client 1
Adresse 1
CP 1
Téléphone 1
Nom client 2
Adresse 2
CP 2
Téléphone 2
doit devenir
Nom client 1 / Adresse 1 / CP 1 / Téléphone 1
Nom client 2 / Adresse 2 / CP 2 / Téléphone 2
Mon code ressemble à ça mais je n'arrive pas à initier la boucle de base pour que ça calcule tout facilement
Sub test()
'
' test Macro
'
'
For i = 0 To 1000
Cells(2, i * 4 + 4).Select
WorksheetFunction.Transpose (i)
Next i = i + 4
End Sub
Je sais que c'est simpliste comme écriture, mais j'ai une seule fois réussi ce foutu comptage qui est horripilant je vous l'avoue et j'aurais bien besoin d'un coup de main :) (50XX lignes à la main, c'est pas possible haha)
PS : Peut y avoir des lignes vides, donc faudrait pas que le comptage soit décaler au fur et à mesure... Je sais je suis très embêtant ^^)
Merci à vous la compagnie !
Bonne soirée et en espérant vous lire rapidement
J'ai un petit code qu'on a tenté de développer avec mon responsable (on est pas informaticien du tout) et en fait on a une base client sur une seule colonne et pour uploader ça dans notre CRM on veut transformer ça en lignes par client.
En gros :
Nom client 1
Adresse 1
CP 1
Téléphone 1
Nom client 2
Adresse 2
CP 2
Téléphone 2
doit devenir
Nom client 1 / Adresse 1 / CP 1 / Téléphone 1
Nom client 2 / Adresse 2 / CP 2 / Téléphone 2
Mon code ressemble à ça mais je n'arrive pas à initier la boucle de base pour que ça calcule tout facilement
Sub test()
'
' test Macro
'
'
For i = 0 To 1000
Cells(2, i * 4 + 4).Select
WorksheetFunction.Transpose (i)
Next i = i + 4
End Sub
Je sais que c'est simpliste comme écriture, mais j'ai une seule fois réussi ce foutu comptage qui est horripilant je vous l'avoue et j'aurais bien besoin d'un coup de main :) (50XX lignes à la main, c'est pas possible haha)
PS : Peut y avoir des lignes vides, donc faudrait pas que le comptage soit décaler au fur et à mesure... Je sais je suis très embêtant ^^)
Merci à vous la compagnie !
Bonne soirée et en espérant vous lire rapidement
3 réponses
Code à essayer pour la colonne BDD en B, il remplace la BDD initiale donc veillez à essayer sur une copie ;) :
Sub test()
Dim DernLigne As Long
DernLigne = Sheets(1).Range("B" & Rows.Count).End(xlUp).Row
For i = 1 To DernLigne
Cells(i, 3).Value = Cells(i + 1, 2).Value 'on met en C l'adresse
Cells(i, 4).Value = Cells(i + 2, 2).Value 'on met en D le CP
Cells(i, 5).Value = Cells(i + 3, 2).Value 'on met en E le tél
Rows(i + 1 & ":" & i + 3).Select
Selection.Delete Shift:=xlUp
Next i
End Sub
Bonjour,
Peut y avoir des lignes vides
entres chaque client ou n'importe ou ??
Peut y avoir des lignes vides
entres chaque client ou n'importe ou ??
Bonjour Messieurs,
Alors le souci c'est que parfois il nous manque des données clients, et je ne connais ni la régularité ni quoi que ce soit. Je peux garantir la redondance du fichier sur les lignes, mais pas le fait que les lignes soient toutes remplies.
Je me suis dit que je pouvais faire un remplacement des cellules vides rien que par un espace pour faire de faux caractères, mais après je ne sais pas si c'est valable.
La deuxième solution à laquelle j'ai pensé c'est dans un premier temps de faire une sélection de toutes les lignes et de mettre un caractère dans chaque cellule vide, mais ça c'est complètement hors de nos compétences.
Merci beaucoup !
Alors le souci c'est que parfois il nous manque des données clients, et je ne connais ni la régularité ni quoi que ce soit. Je peux garantir la redondance du fichier sur les lignes, mais pas le fait que les lignes soient toutes remplies.
Je me suis dit que je pouvais faire un remplacement des cellules vides rien que par un espace pour faire de faux caractères, mais après je ne sais pas si c'est valable.
La deuxième solution à laquelle j'ai pensé c'est dans un premier temps de faire une sélection de toutes les lignes et de mettre un caractère dans chaque cellule vide, mais ça c'est complètement hors de nos compétences.
Merci beaucoup !
La question des cellules vides n'est pas exactement celle à laquelle vous répondez.
Je m'explique :
Cas n°1 : une ligne n'est pas renseignée à juste titre car l'information n'existe pas
Imaginon que le client 2 n'a pas d'adresse renseignée, on aurait :
Cas n°2 : une ligne vide est insérée sans raison entre 2 clients :
=> Le cas n°1 ne pose pas pb avec mon code ; le cas n°2 lui est problématique !
Quel cas rencontrez-vous dans votre doc source ? (il se peut que ce soit les deux!)
Je m'explique :
Cas n°1 : une ligne n'est pas renseignée à juste titre car l'information n'existe pas
Imaginon que le client 2 n'a pas d'adresse renseignée, on aurait :
Nom client 1
Adresse 1
CP 1
Téléphone 1
Nom client 2
CP 2
Téléphone 2
Cas n°2 : une ligne vide est insérée sans raison entre 2 clients :
Nom client 1
Adresse 1
CP 1
Téléphone 1
Nom client 2
Adresse 2
CP 2
Téléphone 2
=> Le cas n°1 ne pose pas pb avec mon code ; le cas n°2 lui est problématique !
Quel cas rencontrez-vous dans votre doc source ? (il se peut que ce soit les deux!)
Bonjour
si tes Nom client se trouve toutes les 4 Ligne
A+
Maurice
si tes Nom client se trouve toutes les 4 Ligne
Sub Macro1()
Nlig = Range("B" & Rows.Count).End(xlUp).Row
Vlig = 4
For L = 2 To Nlig Step 4
Range("B" & L & ":B" & L + 3).Copy
' Copy dans la colonne G
Range("G" & Vlig).PasteSpecial xlPasteValues, , , True
Vlig = Vlig + 1
Next
Application.CutCopyMode = False
End Sub
A+
Maurice
Bonjour,
un autre code, mais meme principe:
un autre code, mais meme principe:
Sub test()
Dim derlig, PB, x
Application.ScreenUpdating = False ' Fige ecran
With Worksheets("feuil1") ' Nom de feuille a adapter
derlig = .Range("A" & Rows.Count).End(xlUp).Row ' Derniere cellule non vide colonne A
PB = 2 ' Pointeur de ligne pour colonne B
For x = 2 To derlig Step 4 ' Boucle de ligne 2 a la fin par pas de 4
.Range("B" & PB).Resize(, 4) = Application.Transpose(.Range("A" & x).Resize(4))
PB = PB + 1 ' Incremente pointeur
Next x
End With
Application.ScreenUpdating = True ' Defige ecran
End Sub