如何根据另一列的值递增某一列的数值

Question

我想在C列和D列中添加n个单元格，其中n是B列中的值。

我的代码如下：

Sub mycode()
Dim lastrow1 As Long
    lastrow1 = Range("A" & Rows.Count).End(xlUp).Row

Dim lastrow2 As Long
    lastrow2 = Range("C" & Rows.Count).End(xlUp).Row

For h = 2 To lastrow1
    For i = 2 To lastrow2
        If Sheet1.Cells(h, 1).Value = Sheet1.Cells(i, 3).Value Then
            P = 10
            t = i + 1
                For j = 1 To Cells(i, 2).Value
                    Sheet1.Cells(t, 3).Insert shift:=xlDown
                    Sheet1.Cells(t, 4).Insert shift:=xlDown
                    Sheet1.Cells(t, 3).Value = Sheet1.Cells(i, 3).Value
                    Sheet1.Cells(t, 4).Value = Sheet1.Cells(i, 4).Value + P
                    P = P + 10
                    t = t + 1
                Next j
        End If
     Next i
Next h
End Sub

示例输入1：

运行上述代码后，输出为：

问题： 现在，当我在第3行添加第二个条目并运行代码时，出现了一些问题：

输入：

代码生成的错误输出：

正确的输出应该是：

我无法弄清楚我的代码出了什么问题。请帮忙解决。

编辑后的样本2：

输入：

输出：

- Abhijeet

---

抱歉标题不够清晰。 - Abhijeet

感谢您的反馈。我已经修改了标题。对造成的不便，我深表歉意。 - Abhijeet

非常好。:-) 谢谢。 - Ken White

Answer 1

我修改了你的代码并添加了注释。

更新后的代码：

Sub mycode()
Application.ScreenUpdating = False 'Optional speedup code
Dim lastrow1 As Long
lastrow1 = Range("B" & Rows.Count).End(xlUp).Row
Dim Inputs() As Variant         'Create an array to hold positions
ReDim Inputs(lastrow1 - 1)      'Make it big enough to hold all positions
For x = 2 To lastrow1           'For each Position
    Inputs(x - 1) = Cells(x, 4) 'Store The Position
Next x
OutRow = 2      'Row to output to
Increment = 10  'Increment
For Each c In Range("B2:B" & lastrow1) 'For each "count"
    For j = 0 To c.Value
        Cells(OutRow, 3).Value = c.Offset(0, -1).Value 'Put the letter in column C
        If j = 0 Then  'If it's the first new letter, start at the position
            Cells(OutRow, 4).Value = Inputs(c.Row - 1)
        Else 'Otherwise, just add our increment to the number above
            Cells(OutRow, 4).Value = Cells(OutRow - 1, 4).Value + Increment
        End If
        OutRow = OutRow + 1
    Next j
Next c
Application.ScreenUpdating = True 'Optional speedup code
End Sub

最终输出:

- user1274820

---

非常感谢user1274820。非常感谢！！！移位是不必要的。你的代码运行得非常好。感谢你的代码和你的大力帮助。 - Abhijeet

我尝试了第二个样本的这段代码（请参见编辑后的样本2），但是代码没有给出预期的输出。输出应该如编辑部分所示。你能帮忙吗？ - Abhijeet

是的，那些第二个输入会改变并且是相关的。 - Abhijeet