separer des valeurs d'une cellule sur plusieur lignes

[jeremy23]

Bonjour,
alors voila ce que jouhaiterais faire, en gros c'est separer les valeurs qui se trouvent aprés une virgule ou un slash pour les recopier dans une ligne en dessous;
et comme une image est plus parlante:



Et le fichier ci joint

 

[job75]

Re : separer des valeurs d'une cellule sur plusieur lignes

Bonjour jeremy23,

Voyez le fichier joint et cette macro (Alt+F11) :

Sub Resultat()
Dim tablo1, i&, s1, ub1%, s2, ub2%, s3, ub3%, s4, ub4%
Dim tablo2(), h&, j As Byte, col As Byte
tablo1 = Range("A3:F" & [A3].End(xlDown).Row)
For i = 1 To UBound(tablo1)
  s1 = Split(tablo1(i, 2), ", "): ub1 = UBound(s1)
  If ub1 >= 0 Then
    s2 = Split(tablo1(i, 4), "/"): ub2 = UBound(s2)
    s3 = Split(tablo1(i, 5), "/"): ub3 = UBound(s3)
    s4 = Split(tablo1(i, 6), "/"): ub4 = UBound(s4)
    ReDim Preserve tablo2(1 To 6, 1 To h + ub1 + 1) 'tableau transposé
    For j = 0 To ub1
      col = h + j + 1
      tablo2(1, col) = CDbl(tablo1(i, 1)) 'nombre de la date
      tablo2(2, col) = Application.Trim(s1(j)) 'fonction SUPPRESPACE
      tablo2(3, col) = tablo1(i, 3)
      If j <= ub2 Then tablo2(4, col) = s2(j)
      If j <= ub3 Then tablo2(5, col) = s3(j)
      If j <= ub4 Then tablo2(6, col) = s4(j)
    Next
    h = h + ub1 + 1
  End If
Next
'---résultat---
If h Then
  With Sheets("Résultat") 'ou ActiveSheet
    .[A3:F65536].ClearContents
    .[A3:F3].Resize(h) = Application.Transpose(tablo2)
    .Activate
  End With
End If
End Sub

C'est mieux d'utiliser la feuille Résultat pour tester.

Mais si l'on veut écraser la 1ère feuille, remplacer à la fin de la macro :

With Sheets("Résultat") par With ActiveSheet

A+

 

[jeremy23]

Re : separer des valeurs d'une cellule sur plusieur lignes

un énorme merci je vais regarder ca pour l'adapter à mon fichier!

 

[pierrejean]

Re : separer des valeurs d'une cellule sur plusieur lignes

Bonjour jeremy23

Vois si cela te convient

Arf: Serieusement a la bourre moi
Salut ami job 🙂 🙂