Question

关于如何为以下场景编写宏，我有一个问题：

我有一堆数据，有一个单元格，其中一些数据包含多个逗号分隔的项目。每次在这一栏中都有逗号时，我希望有一个新行添加了与上面相同的所有数据，但是当前列的上一个项目之后的内容...我知道这一定很难遵循，所以这是一个例子：

ORIGINAL：

应该是：

基本上，每次遇到CORRESPONDING PART列中的逗号时，它都会创建一个包含前一个数据但在逗号后面的单个部分的新行。

Answer 1

正如jswolf19所提到的，您可以使用SPLIT函数将分隔的字符串转换为数组。然后，只需迭代数组中的项目并根据需要插入新行。

以下程序可以帮助您入门。

我假设您的数据位于A：E列中，并使用rng变量进行设置。根据需要修改它。

根据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

Answer 2

试试这个宏： Sub mcrSplit_and_Insert（） Dim i As Long，r As Long，rws As Long，c As Range，vC As Variant 错误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"

下通： Application.ScreenUpdating = True Application.EnableEvents = True 结束子

Answer 3

这也可以通过以下方式完成：

数据-导入来源；
在查询模式下导入源后，右键单击所需列并选择“拆分列”。
在对话框中单击“高级”，然后将拆分模式从列更改为行。

在Excel中编写脚本 - 根据逗号分隔列表插入新行

3 个答案: