Sub Ventiler()
Dim xrg As Range, Deb!
Dim S(), T() As String, R() As String, i&, i1&, i2&, j&, j1&, k&, m&
'vérif sélection
If Selection.Columns.Count <> 1 Then
MsgBox "La selection ne doit comporter qu'une seule colonne"
Exit Sub
ElseIf Selection.Rows.Count <= 1 Then
MsgBox "La selection doit comporter au moins deux lignes " & _
"(vides ou non)"
Exit Sub
End If
'Traitement
Deb = Timer
With Selection
.Offset(, 1).Resize(, 1000).EntireColumn.Clear
Application.ScreenUpdating = False
S = .Value: i2 = UBound(S)
For i = 1 To i2
T = Split(StrConv(S(i, 1), vbUnicode), Chr$(0))
j1 = UBound(T) - 1
If j1 >= 0 Then
ReDim Preserve T(j1)
ReDim R(j1)
j = 0: k = -1
Do Until j > j1
If T(j) <> "[" Then
k = k + 1: R(k) = T(j): j = j + 1
ElseIf T(j) = "[" Then
j = j + 1: k = k + 1
Do Until T(j) = "]"
R(k) = R(k) & T(j): j = j + 1
Loop
If R(k) = "" Then k = k - 1
j = j + 1
End If
Loop
.Offset(i - 1, 1).Resize(1, UBound(R) + 1).Value = R
End If
Next i
End With
Application.ScreenUpdating = True
MsgBox Format(Timer - Deb, "0.0") & " sec."
End Sub