Split cell with multiple lines into rows

Question

I have a workbook with cells that have linebreaks (entered via ALT + ENTER).

I have to separate them into individual rows. All the cells are in column A.

Each line in the cell has a bullet point (eg. "* ") up front, which could serve as a beacon to break the line at this point.

Answer 1

You can use split with Chr(10) or VbLf

Dim cell_value As Variant
Dim counter As Integer

'Row counter
counter = 1

'Looping trough A column define max value
For i = 1 To 10

    'Take cell at the time
    cell_value = ThisWorkbook.ActiveSheet.Cells(i, 1).Value

    'Split cell contents
    Dim WrdArray() As String
    WrdArray() = Split(cell_value, vbLf)

    'Place values to the B column
    For Each Item In WrdArray
        ThisWorkbook.ActiveSheet.Cells(counter, 2).Value = Item
        counter = counter + 1
    Next Item


Next i

No you have array to place each row to different cell

Answer 2

There is no need of code for this, lets make it simple.

Follow the bellow steps.

Select the data-set you want to split -> Go to Data Tab -> Select "Text to columns" -> from this pop-up select "Delimited" -> Select which delimiter is separating your texts -> Select the destination cell -> Click "OK"

Try This.

Regards, Ashwin

Edit from Markus: For the newline as delimiter use "Ctr-J"

Answer 3

If you select the cell and run the macro you would get what you want on the next column like this:

Option Explicit

Public Sub selection_into_rows()


    Dim k           As Variant
    Dim l_counter   As Long

    k = Split(Selection, Chr(10))

    For l_counter = LBound(k) To UBound(k)
        Cells(l_counter + 1, Selection.Column + 1) = k(l_counter)
    Next l_counter

End Sub

Answer 4

只有在选择后才能在一行上工作（但应该让你开始）：

Option Explicit

Public Sub SelectionIntoRows()

Dim k() As String
Dim l As Long
Dim i As Long

k() = Split(Range("A1"), " ")
i = 1
For l = 0 To UBound(k)
    Cells(i, 1) = k(l)
    i = i + 1
Next l

End Sub

Answer 5

Sub extract（）

'查询提取单元格B中的数据除以ALT + Enter，逗号空间 '必须在前面的Sheet1，Sheet2和Sheet3中创建 '注意！如果字段B为空，则不返回任何数据！如果需要，手动添加A列（B列为空）！ '手动删除结果中的空白单元格（Sheet2） '在开始查询之前，请从输入数据中删除重复项！！ ``不能完全停止 “完成后，将显示“完成消息”

将cim设为long，将r设为范围，将I设为long，将d设为long，将Temp（）设为字符串     d = 0     对于每个r In Range（“ B2：B”＆Range（“ B”＆Rows.Count）.End（xlUp）.Row）'更改此设置以适合您的范围。         c = 2         温度=分割（（r.Value），Chr（10））         对于i = LBound（温度）到UBound（温度）

        Sheets("Sheet2").Cells(r.Row, c - 1).Offset(d, 0).Value = Cells(r.Row, r.Column - 1).Value
        Sheets("Sheet2").Cells(r.Row, c).Offset(d, 0).Value = Temp(i)
        Cells(r.Row, c).Offset(d, 0).Select
        ActiveCell.Value = Trim(ActiveCell.Value)
        d = d + 1
    Next
    d = d - 1
Next
Sheets("Sheet2").Select
Columns("A:B").Select
ActiveSheet.Range("$A$1:$B$62856").RemoveDuplicates Columns:=Array(1, 2), _
    Header:=xlYes
Range("A1").Select

Answer 6

我从糟糕的 Acrobat PDF 到 XLSX 转换中有六个这样的 blob，遍布 500 行。 我将文本 blob（如 OP）复制到记事本中，从开始和结束行中删除“”，然后粘贴到新的电子表格中。这告诉我要插入多少行。然后粘贴到那个洞里。

“这就是全部 我的输入文本"

然后我可以使用 TextToCol。