修复代码以正确附加扩展数字

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
Dim j As Long, lastrow As Long

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

Set Rng = Range(Range("H2"), 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("A" & j + 1 & ":H" & j + 1).Value = Range("A" & j & ":H" & j).Value

        j = j + 1
    Next

Next

Next

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

End Sub

当前它正在扩展我的excel文件中一个数字范围的数字范围，每当我尝试添加另一个范围时，它将冻结并且不响应。

例如，这是我仅一行的输入数据：

Input Data

运行代码时，这正是我想要的输出：

Correct Output

但是现在的问题是，每当我要添加另一行这样的数字范围时：

Added Ranges

我的excel窗格将冻结，并告诉我它没有响应。

关于如何设置代码格式以便能够将所有扩展范围附加到新行中的任何想法？谢谢！

Answer 1

大部分时间都在那儿。我假设您的数据从Sheet1和单元格H2开始。此代码删除原始行。我没有添加任何代码来增加PPKLaneID等。但是结构通常就在那里。

Option Explicit

Public Sub Expand()

    Dim vSheet As Worksheet
    Dim vRow As Long
    Dim vOriginalRow As Long
    Dim vCounter As Long
    Dim vCommaGroup As Variant
    Dim vCommaGroups() As String
    Dim vDashGroups() As String

    ' Assume data is in Sheet1 and starts in cell H2 ...
    Set vSheet = Worksheets("Sheet1")
    vRow = 2
    While vSheet.Cells(vRow, 8) <> ""

        ' If this group doesn't contain a dash, then it is single value and not a range
         If InStr(1, vSheet.Cells(vRow, 13), "-") <> 0 Then

            ' Remember the original row as this will be deleted
            vOriginalRow = vRow

            ' Split up the comma groups (can be 1 or more)
            vCommaGroups = Split(vSheet.Cells(vRow, 13), ",")
            For Each vCommaGroup In vCommaGroups()

                ' Split into dash groups
                vDashGroups = Split(vCommaGroup, "-")
                For vCounter = CLng(vDashGroups(LBound(vDashGroups))) To CLng(vDashGroups(UBound(vDashGroups)))

                    ' create space to insert the new data
                    Rows(vRow + 1 & ":" & vRow + 1).Insert Shift:=xlDown

                    ' Duplicate data in columns H through L
                    Range("H" & vRow & ":L" & vRow).Copy Range("H" & CStr(vRow + 1) & ":L" & CStr(vRow + 1))

                    ' and in column M put the number from the range being looped through
                    Range("M" & CStr(vRow + 1)) = vCounter
                    vRow = vRow + 1
                Next
            Next

            ' Delete the original row
            Rows(vOriginalRow).Delete

        End If

        vRow = vRow + 1
    Wend

End Sub

所以从这里...

对此...