☰

Excel：单元格内以逗号分隔的值 - 通过每种组合生成更多行

tag-icon • tag-icon microsoft-excel microsoft-excel-2010
Excel：单元格内以逗号分隔的值 - 通过每种组合生成更多行

我想要从第一个表转到第二个表：

在此处输入图片描述

...为了在数据透视表中使用。我希望第一个表位于一张工作表上，第二个表位于另一张工作表上，实时更新这个“爆炸式”的第二个表。我试了一段时间，但无法让它工作。有什么建议吗？我使用的表单在单个单元格中输出这种以逗号分隔的值的列表类型，在这种情况下，手动执行是不切实际的，因为会有数千行。

答案1

我修改了脚本来自 gtwebb 提供的链接。脚本如下：

Option Explicit

Sub Main()

Columns("B:B").NumberFormat = "@"
Dim i As Long, c As Long, r As Range, v As Variant

For i = 1 To Range("B" & Rows.Count).End(xlUp).Row
    v = Split(Range("B" & i), ", ")
    c = c + UBound(v) + 1
Next i

For i = 2 To c
    Set r = Range("B" & i)
    Dim arr As Variant
    arr = Split(r, ", ")
    Dim j As Long
    r = arr(0)
    For j = 1 To UBound(arr)
        Rows(r.Row + j & ":" & r.Row + j).Insert Shift:=xlDown
        r.Offset(j, 0) = arr(j)
        r.Offset(j, -1) = r.Offset(0, -1)
        r.Offset(j, 1) = r.Offset(0, 1)
    Next j
Next i

Columns("C:C").NumberFormat = "@"
Dim k As Long, d As Long, s As Range, w As Variant

For k = 1 To Range("C" & Rows.Count).End(xlUp).Row
    w = Split(Range("C" & k), ", ")
    d = d + UBound(w) + 1
Next k

For k = 2 To d
    Set s = Range("C" & k)
    Dim arrb As Variant
    arrb = Split(s, ", ")
    Dim m As Long
    s = arrb(0)
    For m = 1 To UBound(arrb)
        Rows(s.Row + m & ":" & s.Row + m).Insert Shift:=xlDown
        s.Offset(m, 0) = arrb(m)
        s.Offset(m, -1) = s.Offset(0, -1)
        s.Offset(m, -2) = s.Offset(0, -2)
    Next m
Next k
End Sub

由于我只需要两列，所以我没有费心循环。唯一需要修改的是脚本重复第二次，变量和参数也发生Offset了变化。

相关内容