PDA

View Full Version : VBA how to: Multi line text in cell to column



jadgon
09-28-2017, 05:23 PM
Hi forum,

I have multi line cells like the below (demo data) in "column B:cells". Some cells are blank

1.259 x x x x x x x x x x x x x x x x x x x x x x x x 6.0000
0.546 y1 y y y y y y y y y y y y y y y y y y y y y y y 0.500000
2.555 v v v v v v v v v v v v v v v v v v v v v v v v 1.500000


Now how to get the output in each cell in next column cells as below:



1.259
0.546
1.555
x
y1
v
x
y
v
x
y
v
x
y
v
x
y
v
x
y
v
x
y
v
x
y
v
x
y
v
x
y
v
x
y
v
x
y
v
x
y
v
x
y
v
x
y
v
x
y
v
x
y
v
x
y
v
x
y
v
x
y
v
x
y
v
x
y
v
x
y
v

6.0000
0.500000
1.500000






























so on .. if data found

mana
09-29-2017, 04:44 AM
Option Explicit


Sub test()
Dim c As Range
Dim s1, s2
Dim w()
Dim v()
Dim i As Long, j As Long
Dim m As Long, n As Long

For Each c In Range("B1", Range("B" & Rows.Count).End(xlUp))
If c.Value <> "" Then
s1 = Split(c.Value, vbLf)
m = UBound(s1) + 1
n = UBound(Split(s1(0))) + 1
ReDim w(1 To m, 1 To n)

For i = 1 To m
s2 = Split(s1(i - 1))
For j = 1 To n
w(i, j) = s2(j - 1)
Next
Next

ReDim v(1 To n)

For j = 1 To n
For i = 1 To m
v(j) = v(j) & vbLf & w(i, j)
Next
v(j) = Mid(v(j), 2)
Next

c.Offset(, 1).Resize(, n).Value = v
End If
Next

End Sub

マナ

jadgon
09-30-2017, 10:47 AM
Thanks but its working only in first cell of column B, I mean only in one cell i.e, B2.

jadgon
09-30-2017, 02:26 PM
Thanks but the code is not working.

jadgon
09-30-2017, 08:43 PM
Here is the problem:
w(i, j) = s2(j - 1)

mana
10-01-2017, 05:43 AM
Please post your workbook with sample data.

jadgon
10-04-2017, 02:29 PM
Please find the attachment.

mdmackillop
10-04-2017, 04:17 PM
Sub SplitData()

Application.ScreenUpdating = False
Set r = Range("B2").Resize(9).SpecialCells(2)
For Each cel In r
x = Split(Trim(cel), Chr(10) & Chr(32))
y = UBound(x)
Z = False
For i = 0 To y
For j = 0 To 15
xx = Split(x(i))
If Z = False Then
Cells(cel.Row, j + 3) = xx(j)
Else
Cells(cel.Row, j + 3) = Cells(cel.Row, j + 3) & Chr(10) & xx(j)
End If
Next
Z = True
Next
Z = False
Next cel
Application.ScreenUpdating = True
End Sub