vba 基于逗号分隔的列表插入行
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/16546311/
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
Insert rows based on comma-separated list
提问by Shivster
Some cells in a column contain more that one item separated by commas.
一列中的某些单元格包含多个以逗号分隔的项目。
I want a row for all the items.
我想要所有项目的一行。
Here is an example:
下面是一个例子：
ORIGINAL:
原来的：
SHOULD BE:
应该：
回答by David Zemens
As jswolf19 mentions, you can use the SPLITfunction to turn a delimited string in to an array. Then, simply iterate over the items in the array and insert new rows as necessary.
正如 jswolf19 提到的，您可以使用该SPLIT函数将分隔字符串转换为数组。然后，只需遍历数组中的项目并根据需要插入新行。
The procedure below should get you started.
下面的过程应该让你开始。
I assume your data is in columns A:E, and set this using the rngvariable. Modify that as needed.
我假设您的数据位于 A:E 列中，并使用rng变量进行设置。根据需要修改它。
Code revised per OP Comments
根据 OP 注释修订的代码
Sub SplitPartsRows()
Dim rng As Range
Dim r As Long
Dim arrParts() As String
Dim partNum As Long
'## In my example i use columns A:E, and column D contains the Corresponding Parts ##
Set rng = Range("A1:BI13876") '## Modify as needed ##'
r = 2
Do While r <= rng.Rows.Count
'## Split the value in column BB (54) by commas, store in array ##
arrParts = Split(rng(r, 54).Value, ",")
'## If there's more than one item in the array, add new lines ##
If UBound(arrParts) >= 1 Then '## corrected this logic for base 0 array
rng(r, 54).Value = arrParts(0)
'## Iterate over the items in the array ##
For partNum = 1 To UBound(arrParts)
'## Insert a new row ##'
'## increment the row counter variable ##
r = r + 1
rng.Rows(r).Insert Shift:=xlDown
'## Copy the row above ##'
rng.Rows(r).Value = rng.Rows(r - 1).Value
'## update the part number in the new row ##'
rng(r, 54).Value = Trim(arrParts(partNum))
'## resize our range variable as needed ##
Set rng = rng.Resize(rng.Rows.Count + 1, rng.Columns.Count)
Next
End If
'## increment the row counter variable ##
r = r + 1
Loop
End Sub
回答by Manab Das
Try this as macro:
试试这个作为宏：
Sub mcrSplit_and_Insert()
Dim i As Long, r As Long, rws As Long, c As Range, vC As Variant
On Error GoTo FallThrough
Application.EnableEvents = False
Application.ScreenUpdating = False
For r = Cells(Rows.Count, 1).End(xlUp).Row To 1 Step -1
If InStr(1, Cells(r, 4).Value, ",") > 0 Then
rws = Len(Cells(r, 4).Value) - Len(Replace(Cells(r, 4).Value, ",", vbNullString))
Cells(r + 1, 4).Resize(rws, 1).EntireRow.Insert
Cells(r, 1).Resize(rws + 1, 9).FillDown
For i = 0 To rws
For Each c In Cells(r + i, 1).Resize(1, 9)
If InStr(1, c.Value, ",") > 0 Then
vC = Split(c.Value, ",")
c = vC(i)
End If
If IsNumeric(c) Then c = c.Value
Next c
Next i
End If
Next r
Columns(2).NumberFormat = "m/d/yy"
FallThrough:
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub
回答by Vlas Lisnyi
This is also can be done via:
这也可以通过：
Data - Import from;
After the source is imported in the Query Mode right click on the required column and choose "Split Columns".
In the dialogue click 'advanced' and change splitting mode from columns to rows.
数据 - 导入自；
在查询模式中导入源后，右键单击所需的列并选择“拆分列”。
在对话框中单击“高级”并将拆分模式从列更改为行。
