格式化代码以输出新行以扩展编号

Question

我有此代码

    Sub ExpandRanges()

    Dim X As Long, CG As Variant, Rng As Range, Cell As Range
    Dim Series As String, CommaGroups() As String, DashGroups() As String
    Set Rng = Range(Range("H2"), Cells(Rows.Count, "H").End(xlUp))
    For Each Cell In Rng
    CommaGroups = Split(Cell, ",")
    For Each CG In CommaGroups
    DashGroups = Split(CG, "-")
    For X = DashGroups(0) To DashGroups(UBound(DashGroups))
    Series = Series & ", " & X
    Next
    Next
    Cell.Offset(, 1).Value = Mid(Series, 3)
    Series = ""
    Next

    End Sub

这给了我和输出：

有人可以将代码重新格式化为它为从范围扩展的每个数字创建新行的地方吗？而不是将它们扩展到新的列中，而我不得不手动将它们再次分开。

我希望它看起来像这样（指第一个范围）

Answer 1

尝试一下：

编辑：固定

Sub ExpandRanges()

Dim X As Long, CG As Variant, Rng As Range, Cell As Range
Dim Series As String, CommaGroups() As String, DashGroups() As String
Dim j As Long, lastrow As Long, newrow as Long

j = 0
lastrow = Cells(Rows.Count, "H").End(xlUp).Row

newrow = InputBox("What is the row number of your new range?")

Set Rng = Range(Range("H" & newrow), Range("H" & lastrow))

For Each Cell In Rng

    CommaGroups = Split(Cell, ",")

    For Each CG In CommaGroups

        DashGroups = Split(CG, "-")

        For X = DashGroups(0) To DashGroups(UBound(DashGroups))
            If j = 0 Then j = Split(Cell.Address, "$")(2)

            Rows(j + 1 & ":" & j + 1).Insert Shift:=xlDown
            Cells(j, 9).Value = X

            Range("C" & j + 1 & ":H" & j + 1).Value = Range("C" & j & ":H" & j).Value

            j = j + 1
        Next

    Next

Next

'Band-aid solution
lastrow = Cells(Rows.Count, "H").End(xlUp).Row
Range("C" & lastrow & ":H" & lastrow).ClearContents

End Sub