VBA Convertir lignes d'une cellule en colonne

Résolu
Wynan -  
 Wynan -
Bonjour a tous,
J'aimerai faire une macro VBA Excel pour transformer les lignes se trouvant dans une cellule en plusieurs colonne de sorte que les données ne soient pas alignés sur chaque ligne dans la cellule mais en plusieurs colonne côte-à-côte. (j'espère me faire comprendre!!!) J'ai essayé ça mais ça ne marche pas. si quelqu'un peux me corriger svp !

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
alpha = Chr(10)
k = 1

motaverif = ActiveCell.Value
i = ActiveCell.Row
j = ActiveCell.Column

Do
temp = Mid(motaverif, k, 1)
posi = InStr(temp, alpha)

Cells(i, j + 1).Value = Right(motaverif, Len(motaverif) - posi + 2)
motaverif = Right(motaverif, Len(motaverif) - posi + 2)
j = j + 1
k = k + 1

Loop Until k > Len(motaverif)

End sub
Configuration: Windows vista
Firefox 3.0.5

3 réponses

  1. melanie1324 Messages postés 1561 Statut Membre 156
     
    Bonjour,

    Je n'ai pas regardé ton code mais ce que tu peux faire c'est enregistres ta macro.
    Sélectionnes te slignes et copies les
    choisis ta colonne et fais un collage spécial aen coochant transposé.

    Tu auras le code et tu pourras voir ce qui n'allait pas avec le tien
    0
  2. melanie1324 Messages postés 1561 Statut Membre 156
     
    Re,

    J'avais mal compris excuse moi.
    La proposition que je t'ai faite n'est pas bonne.

    Par contre, je sais ou est l'erreur dans ton code :
    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
    alpha = Chr(10)
    k = 1

    motaverif = ActiveCell.Value
    i = ActiveCell.Row
    j = ActiveCell.Column

    Do while k > Len(motaverif)

    temp = Mid(motaverif, k, 1)
    posi = InStr(temp, alpha)

    Cells(i, j + 1).Value = Right(motaverif, Len(motaverif) - posi + 2)
    motaverif = Right(motaverif, Len(motaverif) - posi + 2)
    j = j + 1
    k = k + 1

    Loop

    End sub
    0
    1. Wynan
       
      Merci Mélanie de te pencher sur mon problème mais ta modification n'a pas l'effet souhaité. j'en suis toujours au même point snif!
      0
  3. melanie1324
     
    Bonjour,

    Je ne m'y étais pas assez penché dessus :
    essaie ca:
    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
    alpha = Chr(10)
    k = 1

    motaverif = ActiveCell.Value
    i = ActiveCell.Row
    j = ActiveCell.Column

    Do while k > Len(motaverif)

    temp = Mid(motaverif, k, 1)
    posi = InStr(temp, alpha)

    Cells(i, j + 1).Value = Right(motaverif, Len(motaverif) - posi + 2)
    motaverif = left(motaverif, Len(motaverif) - posi + 2) 'cest ca ki ne va pas tu prenais la droite alors qu'il faut prendre la gauche
    j = j + 1
    k = k + 1
    Loop
    end sub
    0
    1. Wynan
       
      Merci Mélanie effectivement j'ai oublié qu'il fallait aussi prendre à gauche. Je te donne le programme complet qui marche (combinaison de ton idée et de ce que j'avais fais). Merci encore!!!!!!

      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
      0