Excel子例程，将以逗号分隔的值转置为行

Question

我有一个问题，在工作中我被要求获取数据集并进行一些修改。 问题是，存在一个包含值1,2,3,4-10,13-17,20字段，我必须扩展单元格中的多个范围，将图转置为行，然后复制其余的与它的行。

例：

FIELD1 FIEL2 FIELD3 FIELD4
test1  test2 test3  1,2,3,4-10

应该变成：

FIELD1 FIEL2 FIELD3 FIELD4
test1  test2 test3  1
test1  test2 test3  2
test1  test2 test3  3
test1  test2 test3  4
test1  test2 test3  5
test1  test2 test3  6

并对所有其余行重复相同的操作，直到找到一个空单元格。

在下面，您可以看到我的《科学怪人》子程序，该子程序是我开发的，一部分是通过其他来源缝合而成的。 问题是，这确实可以部分起作用，但是如果一行以上，它就不能正确地完成工作。 你可以试试：

Select the first cell and run the routine from a button
1,2,3
4,5,6

有帮助吗？ 提前致谢。

Sub Ops()

    'DECLARE VARIABLES
    Dim i As Long, st As String
    i = 1
    Dim startP As Range
    Dim c As Collection
    Dim count As Integer
    Set c = New Collection
    ary = Split(ActiveCell.Value, ",")

    Do Until IsEmpty(ActiveCell.Value)
        count = 0

        For Each r In Selection
            If i = 1 Then
                st = r.Text
                i = 1
            Else
                st = st & "," & r.Text
            End If
        Next r

        Set startP = Selection(1, 2)
        ary = Split(st, ",")
        i = 1

        For Each a In ary
            count = count + 1
            startP(i, 1).Value = a
            i = i + 1
        Next a

        'COUNT MINUS 1
        scount = count - 1

        'REPEAT UNTIL REACH COUNT
        For ba = 1 To scount
            'COPY AND INSERT ROWS BELOW
            ActiveCell.Copy
            Selection.Insert Shift:=xlDown
        Next ba

        Selection.Offset(count, 1).Select

        'ONCE THE LOOP IS FINISH GO TO NEXT CELL
        Selection.Offset(0, -1).Select

    Loop

End Sub

您可以在下面看到数据

在“邮政编码”单元格中，我需要扩展多个范围，并在同一行Xtimes的下方复制并插入该单元格中的邮政编码数。

Answer 1

这段代码满足了您的要求-请注意，我没有定义明确的单元格引用，因为我们将其基于ActiveCell，所以我将Ranges保留为Range而不是worksheet.Range

Sub x()
Do While ActiveCell.Value2 <> ""
    If InStr(1, ActiveCell.Value2, ",") > 0 Or InStr(1, ActiveCell.Value2, "-") > 0 Then e
    ActiveCell.Offset(1, 0).Select
Loop
End Sub
Sub e()

Dim a As Long
Dim r As Long
Dim c As Long
Dim rc As Long
Dim i As Long
Dim j As Long
Dim x() As String
Dim t() As String

    x = Split(ActiveCell, ",")
    r = ActiveCell.Row
    c = ActiveCell.Column


    For i = LBound(x) To UBound(x)
        If InStr(1, x(i), "-") Then
            a = a + Split(x(i), "-")(1) - Split(x(i), "-")(0)
        End If
    Next i

    a = a + UBound(x)
    Range(Cells(r + 1, c), Cells(r + a, c)).EntireRow.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove

    For i = LBound(x) To UBound(x)
        t = Split(x(i), "-")
        If UBound(t) = 0 Then
            Cells(r + rc, c).Value2 = t(0)
            rc = rc + 1
        Else
            For j = t(0) To t(1)
                Cells(r + rc, c).Value2 = j
                rc = rc + 1
            Next j
        End If
    Next i

    Range(Cells(r, c - 3), Cells(r + rc - 1, c - 1)).Value2 = _
        Range(Cells(r, c - 3), Cells(r, c - 1)).Value2

End Sub

这基本上是根据数字x,y,ab,z通过首先在上进行拆分,然后在-

之后，它已经有了行计数器rc因此只需使用该计数器将范围从上到下进行泛洪，在活动单元格之前的3列中复制值

编辑：我添加了5行，实际上经过了范围（1、2、4-7），以在实际填写信息之前计算要INSERT多少行。

EDIT2：我添加了另一个名为x子例程，以使该e例程循环直到到达其中没有任何内容的单元格为止。因此，要固定整个工作表，只需突出显示范围为（1,3， 4-7 ...等），然后运行x例程