Sub Autre_Tableau()
Dim source, final, lignes1, lignes2, max As Long, i As Long, j As Long
With Worksheets("Feuil1")
' transfert des valeurs du tableau source dans la variable source
' qui sera un tableau de deux colonnes et d'autant de lignes que
' le nombre de lignes du tableau à convertir
source = .Range("A3:B" & .Cells(.Rows.Count, "a").End(xlUp).Row).Value
' boucle sur chaque ligne du tableau source
For i = LBound(source) To UBound(source)
'transformer l'élément de source (ligne 1, colonne 1) en un tableau
' le séparateurs d'élément est le retour à la ligne: CHR(10)
lignes1 = Split(source(i, 1), Chr(10))
' Le nombre de mots (ou lignes)
max = UBound(lignes1) - LBound(lignes1) + 1
' idem pour la 2ième colonne
lignes2 = Split(source(i, 2), Chr(10))
' on recherche le max des nombres de lignes (ou mots)
If UBound(lignes2) > UBound(lignes1) Then max = UBound(lignes2) - LBound(lignes2) + 1
' on transforme chaque tableau afin qu'ils aient le même nombre de lignes
ReDim Preserve lignes1(LBound(lignes1) To max)
ReDim Preserve lignes2(LBound(lignes2) To max)
' si le tableau résultat (final) n'est pas un tableau, cela veut dire
' qu'il faut le créer.
If Not IsArray(final) Then
' on crée le tableau (2 lignes, max colonne). Le tableau final est en colonne
' car seule la dernière dimension est modifiable tout en gardant les valeurs
' déjà présentes dans le tableau. il faudra donc transposer le tableau final
' lors de son écriture sur la feuille excel.
ReDim final(1 To 2, 1 To max)
' on remplit le tableau final avec les éléments de chaque ligne
For j = 1 To max
final(1, j) = lignes1(j - 1)
final(2, j) = lignes2(j - 1)
Next j
Else
' si le tableau final existe déjà, on l'étend de max colonnes
' en gardant ses précédentes valeurs
ReDim Preserve final(1 To 2, 1 To UBound(final, 2) + max)
' on complète le tableau final avec les éléments de chaque ligne
For j = 1 To max
final(1, UBound(final, 2) - (max - j)) = lignes1(j - 1)
final(2, UBound(final, 2) - (max - j)) = lignes2(j - 1)
Next j
End If
Next i
'on transfère le tableau final sur la feuille
' on efface les colonnes D et E
.Range("D:E").Clear
' on écrit le tableau final sur la feuille
.Range("D3").Resize(UBound(final, 2) - LBound(final, 2) + 1, 2).Value = Application.Transpose(final)
' on place les bordures
.Range("D3").Resize(UBound(final, 2) - LBound(final, 2) + 1, 2).Borders.LineStyle = xlContinuous
' on aligne le contenu des cellules sur la bordure du haut des cellules
.Range("D3").Resize(UBound(final, 2) - LBound(final, 2) + 1, 2).VerticalAlignment = xlTop
End With
End Sub
