Question

我有这张桌子：

Quantity   Name
1          A
3          C1
3          C2
4          D

我正在尝试将此表格更改为：

Quantity   Name
1          A
1          A
3          C1
3          C1
3          C1
3          C2
3          C2
3          C2
4          D
4          D
4          D
4          D

但结果并不如预期：结果

请帮助我解决这个问题。谢谢！

这是我的代码：

Sub newrow()
 Dim xRg As Range
    Dim xAddress As String
    Dim I, xNum, xLastRow, xFstRow, xCol, xCount As Long
    On Error Resume Next
    xAddress = ActiveWindow.RangeSelection.Address
    Set xRg = Application.InputBox("Select a range to use(single column):", "KuTools For Excel", xAddress, , , , , 8)
    If xRg Is Nothing Then Exit Sub
    Application.ScreenUpdating = False
    xLastRow = xRg(1).End(xlDown).Row
    xFstRow = xRg.Row
    xCol = xRg.Column
    xCount = xRg.Count
    Set xRg = xRg(1)
    For I = xLastRow To xFstRow Step -1
        xNum = Cells(I, xCol)
        If IsNumeric(xNum) And xNum > 0 Then
            Rows(I + 1).Resize(Cells(I, xCol) - Cells(I - 1, xCol)).Insert
            xCount = xCount + xNum
        End If
    Next
    xRg.Resize(xCount, 1).Select
    Application.ScreenUpdating = True
End Sub

Answer 1

首先......

如果您Dim xFstRow, xCol, xCount As Long，则只有xCount类型为Long，其他所有类型均为Variant。您需要为每个变量指定一个类型！
```
Dim xFstRow As Long, xCol As Long, xCount As Long
```
如果没有正确的错误处理，请不要使用On Error Resume Next。这只隐藏错误消息，但仍然会发生错误，你只是看不到它们。因此，您无法调试/修复您的代码。完全删除它或实现完整的错误处理。
您需要在插入之前复制该行，否则只需插入空行。

我建议使用以下代码：

Option Explicit

Public Sub AddRowsFromQantities()
    Dim SelAddress As String
    SelAddress = ActiveWindow.RangeSelection.Address

    Dim SelRange As Range
    Set SelRange = Application.InputBox("Select a range to use(single column):", "KuTools For Excel", SelAddress, , , , , 8)

    Dim fRow As Long
    fRow = SelRange.Row 'first row of selected rang

    Dim lRow As Long
    lRow = fRow + SelRange.Rows.Count - 1 'last row of selected range

    'find last used row within the selected range
    If Cells(Rows.Count, 1).End(xlUp).Row < lRow Then
        lRow = Cells(Rows.Count, 1).End(xlUp).Row
    End If

    Application.ScreenUpdating = False

    Dim iRow As Long
    For iRow = lRow To fRow Step -1
        If IsNumeric(Cells(iRow, 1)) Then
            Dim Quantity As Long
            Quantity = Cells(iRow, 1).Value

            If Quantity > 1 Then
                Rows(iRow).Copy 
                Rows(iRow).Resize(RowSize:=Quantity - 1).Insert
            End If
        End If
    Next iRow

    Application.CutCopyMode = False
    Application.ScreenUpdating = True
End Sub

使用VBA基于单元格值插入和复制行

1 个答案: