vba 如何将单个单元格拆分为多行并添加另一行
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/35439099/
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
How to Split a single cell into multiple rows and add another row
提问by Sam
I have a table that has two Columns. Date and Test Name. What I would like to happen is that the string of text in one single cell be separated into multiple rows. In addition, I need the date to be associated with each set of text. I have tried text to columns and then transpose, but it can only handle 1 set of string at a time and not the entire data set.
我有一个有两列的表。日期和测试名称。我想要发生的是将单个单元格中的文本字符串分成多行。此外，我需要将日期与每组文本相关联。我曾尝试将文本转换为列然后转置，但它一次只能处理一组字符串，而不是整个数据集。
回答by Davesexcel
Loop through Column A then loop through the string next to it.
循环遍历 A 列，然后循环遍历它旁边的字符串。
Results will be in column D
结果将在 D 列中
Sub ChickatAH()
Dim rng As Range, Lstrw As Long, c As Range
Dim SpltRng As Range
Dim i As Integer
Dim Orig As Variant
Dim txt As String
Lstrw = Cells(Rows.Count, "A").End(xlUp).Row
Set rng = Range("A2:A" & Lstrw)
For Each c In rng.Cells
Set SpltRng = c.Offset(, 1)
txt = SpltRng.Value
Orig = Split(txt, " ")
For i = 0 To UBound(Orig)
Cells(Rows.Count, "D").End(xlUp).Offset(1) = c
Cells(Rows.Count, "D").End(xlUp).Offset(, 1) = Orig(i)
Next i
Next c
End Sub
回答by Colin Stadig
This will require a bit of copy and paste and also the use of WORD but here are a few steps that should help you out.
这将需要一些复制和粘贴以及 WORD 的使用，但这里有几个步骤可以帮助您。
- Copy the cell in question.
- Open Word
- Paste Special (use the dropdown arrow below the paste icon)
- Select the option - Unformatted Unicode Text (as your paste special option)
- Select All
- Replace
- Find What: (type in the space) Replace With: ^p (creates a new line)
- Copy and paste results back into excel
- 复制有问题的单元格。
- 打开字
- 选择性粘贴（使用粘贴图标下方的下拉箭头）
- 选择选项 - 未格式化的 Unicode 文本（作为粘贴特殊选项）
- 全选
- 代替
- 查找内容：（在空格中输入）替换为：^p（创建一个新行）
- 将结果复制并粘贴回 Excel
回答by user3471272
A formula solution is close to your requirement.
配方解决方案接近您的要求。
Cell H1is the delimiter. In this case a space.
单元格H1是分隔符。在这种情况下，一个空格。
Helper E1:=SUM(E1,LEN(B1)-LEN(SUBSTITUTE(B1,$H,"")))+1
You must fill the above formula one row more.
您必须将上述公式再填写一行。
A8:=a1
Fill this formula to the right.
把这个公式填到右边。
A9:=LOOKUP(ROW(1:1),$E:$E,A:A)
Fill this formula to the right and then down.
向右填充这个公式，然后向下填充。
B9:=MID($H&LOOKUP(ROW(A1),E:E,B:B)&$H,FIND("ܳ",SUBSTITUTE($H&LOOKUP(ROW(A1),E:E,B:B)&$H,$H,"ܳ",ROW(A2)-LOOKUP(ROW(A1),E:E)))+1,FIND("ܳ",SUBSTITUTE($H&LOOKUP(ROW(A1),E:E,B:B)&$H,$H,"ܳ",ROW(A2)-LOOKUP(ROW(A1),E:E)+1))-FIND("ܳ",SUBSTITUTE($H&LOOKUP(ROW(A1),E:E,B:B)&$H,$H,"ܳ",ROW(A2)-LOOKUP(ROW(A1),E:E)))-1)
Fill down.
填下来。
Bug:
漏洞：
Date/time will be converted to value and blank will be filled with 0. You can add &"" to the end of the formula of A9and B9to block the value 0, but numbers/date/time will be converted to text.
日期/时间将被转换成值和空白将被填为0可以添加＆“”到的式的端部A9和B9到块的值为0，但数/日期/时间将被转换为文本。
