在Excel中编写脚本 – 基于逗号分隔的列表插入新行
我有一个问题，我将如何编码一个macros的以下情况：
我有一堆数据，并且有一个单元格对于这些数据中的一些包含多个用逗号分隔的项目。 每一次在这一列中都有一个逗号，我希望在那里有一个新的行，添加了与上面所有相同的数据，但与当前列的前一个项目之后的内容相同…我知道这一定很难，所以这里是一个例子：
原版的： 
应该： 
因此，基本上，每当在“相应CORRESPONDING PART列中遇到逗号时，它将创build一个新的行，其中包含以前的数据，而逗号之后的单个部分。
正如jswolf19所提到的，你可以使用SPLIT函数将一个分隔string转换为一个数组。 然后，只需遍历数组中的项目并根据需要插入新行。
下面的程序应该让你开始。
我假设你的数据在A：E列中，并使用rngvariables进行设置。 根据需要修改。
代码根据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
试试这个macros：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