Convertir lignes d'une cellule en colonnes

Résolu
Jimmy59116 Messages postés 48 Statut Membre -  
Jimmy59116 Messages postés 48 Statut Membre -
Bonjour,

Mélanie 1324 et Wyan ont travaillé sur une macro permettant de diviser les données d'une cellule contenant plusieurs lignes en colonnes.

Comment faire pour appliquer cette macro à plusieurs cellules à la fois ?

Je travaille sur un document dont chacune des lignes doit être traitées de la même manière.

La macro présentée travaille avec la cellule active.

Quelles transformation peut permerttre d'attaquer la macro en D2 et de traiter en boucle jusqu'à la dernière ligne contenant des données ?

Sub transform_cellule()
Dim motaverif As String
Dim temp As String, alpha As String
Dim i As Long, j As Long, k As Long, posi As Long
Dim test As Boolean
alpha = Chr(10)
k = 1
test = False
motaverif = ActiveCell.Value
i = ActiveCell.Row
j = ActiveCell.Column

Do While k <= Len(motaverif)

temp = Mid(motaverif, k, 1)
posi = InStr(motaverif, alpha)
test = posi > 0
If test Then
Cells(i, j).Value = Left(motaverif, posi - 1)
Cells(i, j + 1).Value = Right(motaverif, Len(motaverif) - posi)
motaverif = Cells(i, j + 1).Value
k = 0
j = j + 1
End If

k = k + 1
Loop
End Sub


D'avance, je vous remercie pour votre aide.

Jimmy

5 réponses

Réponse 1 / 5
michel_m Messages postés 18903 Date d'inscription   Statut Contributeur Dernière intervention   3 318
 
Bonjour

Peut-^tre plus simple en utilisant VBA 

Dim derlig As Long, lig As Long
Dim tablo
derlig = Cells(Cells.Rows.Count, 4).End(xlUp).Row
Application.ScreenUpdating = False
For lig = 2 To derlig
    tablo = Split(Cells(lig, 4), Chr(10))
    Cells(lig, 5).Resize(1, UBound(tablo) + 1) = tablo
Next
1
Réponse 2 / 5
Jimmy59116 Messages postés 48 Statut Membre 1
 
Merci pour votre aide. La solution de Mélanie n'a pas fonctionné comme prévu, celle de Michel en revanche fonctionne à merveille.

Merci à toi Michel, ce n'est pas la première fois que tu me dépatouilles avec tes solutions miracles !
1
Réponse 3 / 5
melanie1324 Messages postés 1561 Statut Membre 155
 
bonjour,

tu rajoutes une boucle

en début de code :
i = 2
do while cells(i,4)<>"" 's'exécute jusqu'à ce que la ligne i, col 4 contient quelque chose

en fin de code
i=i+1 'on passe à la ligne suivante
loop
0
Réponse 4 / 5
Jimmy59116 Messages postés 48 Statut Membre 1
 
Bonjour Melanie,

Pour combiner le code, voici ce que j'ai écrit :

Sub transform_cellule()
Dim motaverif As String
Dim temp As String, alpha As String
Dim i As Long, j As Long, k As Long, posi As Long
Dim test As Boolean
alpha = Chr(10)
k = 1
test = False
motaverif = ActiveCell.Value
i = ActiveCell.Row
j = ActiveCell.Column

i = 2
Do While Cells(i, 4) <> "" 's'exécute jusqu'à ce que la ligne i, col 4 contient quelque chose
Do While k <= Len(motaverif)

temp = Mid(motaverif, k, 1)
posi = InStr(motaverif, alpha)
test = posi > 0
If test Then
Cells(i, j).Value = Left(motaverif, posi - 1)
Cells(i, j + 1).Value = Right(motaverif, Len(motaverif) - posi)
motaverif = Cells(i, j + 1).Value
k = 0
j = j + 1
End If

k = k + 1
Loop

i = i + 1 'on passe à la ligne suivante
Loop

End Sub


Je découvre à peine les fonctions for each do while etc... et visiblement, j'ai encore du mal !

Pourrais tu m'indiquer la correction et éventuellement m'expliquer rapidement comment organiser les arguments ?

Merci pour ton aide.

Jimmy
0

Vous n’avez pas trouvé la réponse que vous recherchez ?

Posez votre question
Réponse 5 / 5
melanie1324 Messages postés 1561 Statut Membre 155
 
re,

j'avais mal lue;

Voici la combinaison :

Sub transform_cellule()
Dim motaverif As String
Dim temp As String, alpha As String
Dim a,i As Long, j As Long, k As Long, posi As Long
Dim test As Boolean
alpha = Chr(10)


a = 2
Do While Cells(a, 4) <> "" 's'exécute jusqu'à ce que la ligne i, col 4 contient quelque chose

k = 1
test = False
motaverif = ActiveCell.Value
i = ActiveCell.Row
j = ActiveCell.Column


Do While k <= Len(motaverif)

temp = Mid(motaverif, k, 1)
posi = InStr(motaverif, alpha)
test = posi > 0
If test Then
Cells(i, j).Value = Left(motaverif, posi - 1)
Cells(i, j + 1).Value = Right(motaverif, Len(motaverif) - posi)
motaverif = Cells(i, j + 1).Value
k = 0
j = j + 1
End If

k = k + 1
Loop

a = a + 1 'on passe à la ligne suivante
Loop

End Sub
0