Convertir lignes d'une cellule en colonnes
Résolu
Jimmy59116
Messages postés
48
Statut
Membre
-
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
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
-
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 -
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 ! -
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 -
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 -
Vous n’avez pas trouvé la réponse que vous recherchez ?
Posez votre question -
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
