vba 将文本转换为行而不是文本到列
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/25433730/
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
Convert Text to Rows instead of Text to Columns
提问by Rod
I have a text string that is using the ^symbol as a delimiter.
我有一个使用该^符号作为分隔符的文本字符串。
I need to separate the text into new rows rather than new columns.
我需要将文本分成新行而不是新列。
I need to create new rows to not overwrite the next line of data below it.
我需要创建新行以不覆盖它下面的下一行数据。
Is this possible without using a macro? I'm not against using one, I just wouldn't know where to start to write it.
这可能不使用宏吗？我不反对使用一个，我只是不知道从哪里开始写它。
Below is a pic of some sample data. The top part is how it's listed, and the bottom (in yellow) is how I would like it.
下面是一些示例数据的图片。顶部是它的列出方式，底部（黄色）是我想要的。
Using Excel 2010 on Windows 7 Pro.
在 Windows 7 Pro 上使用 Excel 2010。
回答by Rod
Thanks to those that responded. A friend was able to help by providing the following code:
感谢那些做出回应的人。一位朋友能够通过提供以下代码来提供帮助：
Sub Breakout()
Application.ScreenUpdating = False
LR = Cells(Rows.Count, 1).End(xlUp).Row
For r = LR To 2 Step -1
Set MyCell = Cells(r, 1)
Arry = Split(MyCell.Value, "^")
For c = 0 To UBound(Arry)
If c > 0 Then MyCell.Offset(c, 0).EntireRow.Insert
MyCell.Offset(c, 0) = Arry(c)
Next c
Next r
End Sub
回答by IAmDranged
Could try something like this:
可以尝试这样的事情：
Sub reArrange()
Dim inFirstRng As Range
Dim inRng As Range
Dim inCur As Variant
Dim outFirstRng As Range
Dim outCurRng As Range
Dim ws As Worksheet
'CHANGE ARGUMENT TO YOUR SHEET NAME
Set ws = Worksheets("Sheet2")
With ws
'CHANGE ARGUMENT TO WHATEVER THE FIRST CELL OR YOUR DATA INPUT IS IN COLUMN A
Set inFirstRng = .Range("A3")
Set inRng = .Range(inFirstRng, inFirstRng.End(xlDown))
'CHANGE ARGUMENT TO WHATEVER THE FIRST CELL OR YOUR DATA OUTPUT IS IN COLUMN A
Set outFirstRng = .Range("A9")
Set outCurRng = outFirstRng
End With
For Each cell In inRng.Cells
inCur = WorksheetFunction.Transpose(Split(cell.Value, "^"))
outCurRng.Resize(UBound(inCur), 1).Value = inCur
With ws
.Range("G" & outCurRng.Row & ":L" & outCurRng.Row).Value = _
.Range("G" & cell.Row & ":L" & cell.Row).Value
End With
Set outCurRng = outCurRng.Offset(UBound(inCur), 0)
Next cell
ws.Range("F" & outFirstRng.Row & ":F" & outCurRng.Row - 1).Value = 1
End Sub
