vba 将多行单元格拆分成行
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/36835884/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
Split cell with multiple lines into rows
提问by Armitage2k
I have a workbook with cells that have linebreaks (entered via ALT + ENTER).
我有一个带有换行符的单元格的工作簿（通过 ALT + ENTER 输入）。
I have to separate them into individual rows. All the cells are in column A.
我必须将它们分成单独的行。所有单元格都在 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.
单元格中的每一行前面都有一个项目符号（例如“*”），它可以作为在这一点上打破线条的灯塔。
回答by user4845680
You can use split with Chr(10) or VbLf
您可以将 split 与 Chr(10) 或 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
不，你有数组将每一行放置到不同的单元格
回答by Ashwin
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"
来自 Markus 的编辑：对于作为分隔符的换行符，请使用“Ctr-J”
回答by Vityata
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
回答by Brian
This will work on one row only after selecting it (but should get you started):
这仅在选择后才适用于一行（但应该让您开始）：
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
回答by Ivica
Sub extract()
子提取（）
'Query extract data in cell B divided by ALT+Enter, Comma space 'Mandatory to create in front Sheet1, Sheet2, and Sheet3 'ATTENTION! if field B is empty return no data!! Manually add column A (with empty column B)if needed!! 'manually remove empty cell in results (Sheet2) 'before START Query remove duplicate from input data!! 'Doesn't work with full stop 'When finished Msg Done will be display
'查询 B 单元格中的提取数据，除以 ALT+Enter，逗号空格 '必须在前面的 Sheet1、Sheet2 和 Sheet3 中创建 '注意！如果字段 B 为空，则不返回任何数据！！如果需要，手动添加 A 列（带有空 B 列）！！'在结果（Sheet2）中手动删除空单元格'在开始查询之前从输入数据中删除重复项！！'不能用句号'完成后将显示完成消息
Dim c As Long, r As Range, I As Long, d As Long, Temp() As String d = 0 For Each r In Range("B2:B" & Range("B" & Rows.Count).End(xlUp).Row) ' Change this to suit your range.. c = 2 Temp = Split((r.Value), Chr(10)) For i = LBound(Temp) To UBound(Temp)
Dim c As Long, r As Range, I As Long, d As Long, Temp() As String d = 0 For Each r In Range("B2:B" & Range("B" & Rows.Count).End( xlUp).Row) ' 更改它以适合您的范围.. c = 2 Temp = Split((r.Value), Chr(10)) For i = LBound(Temp) To UBound(Temp)
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:$B856").RemoveDuplicates Columns:=Array(1, 2), _
Header:=xlYes
Range("A1").Select
