插入缺less顺序值的行，Excel VBA

我正在使用下面的VBA代码插入一个空行，其中在Excel中缺less一个顺序值。

Sub test() Dim i As Long, x, r As Range For i = Range("b" & Rows.Count).End(xlUp).Row To 2 Step -1 x = Mid$(Cells(i, "b"), 2) - Mid$(Cells(i - 1, "b"), 2) If x > 1 Then Rows(i).Resize(x - 1).Insert Cells(i - 1, "b").AutoFill Cells(i - 1, "b").Resize(x), 2 End If Next 

这工作正常，除非最后一个值是缺less的。
例如，我正在填补5人组的空白。
中间数字丢失的地方：
1
2
4
五
代码将为缺less的值插入一个空行以变为：
1
2

4
五
但是，如果最后的值5缺失，则不会插入一行。
所以：
1
2
4
变为：
1
2

4
有没有办法设置最大值，以确保最终的价值将被确认为失踪？

Answer 1

尝试这个…

 Sub test() Dim i As Long, x, r As Range, lMax As Long, lRw As Long lRw = Range("b" & Rows.Count).End(xlUp).Row + 1 lMax = InputBox("Enter Maximum Value", "Maximum Input Req.", Application.Max(Range("B2:B" & lRw))) For i = lRw To 2 Step -1 If i = lRw Then x = lMax - Mid$(Cells(i - 1, "b"), 2) If x > 1 Then Cells(i - 1, "b").AutoFill Cells(i - 1, "b").Resize(x + 1), 2 End If Else x = Mid$(Cells(i, "b"), 2) - Mid$(Cells(i - 1, "b"), 2) If x > 1 Then Rows(i).Resize(x - 1).Insert Cells(i - 1, "b").AutoFill Cells(i - 1, "b").Resize(x), 2 End If End If Next End Sub 

修订的代码

 Sub test() Dim i As Long, x, r As Range, lMax As Long, lRw As Long lRw = Range("b" & Rows.Count).End(xlUp).Row + 1 lMax = InputBox("Enter Maximum Value", "Maximum Input Req.", Application.Max(Range("B2:B" & lRw))) For i = lRw To 2 Step -1 If i = lRw Then x = lMax - Cells(i - 1, "b").Value If x > 1 Then Cells(i - 1, "b").AutoFill Cells(i - 1, "b").Resize(x + 1), 2 End If Else x = Cells(i, "b").Value - Cells(i - 1, "b").Value If x > 1 Then Rows(i).Resize(x - 1).Insert Cells(i - 1, "b").AutoFill Cells(i - 1, "b").Resize(x), 2 End If End If Next End Sub 

Answer 2

这个答案是在另一个论坛上给我的：

http://www.ozgrid.com/forum/showthread.php?t=200184&goto=newpost **

 Sub Reply() i = 1 Do While Cells(i, 2) <> "" j = Cells(i + 1, 2).Value - Cells(i, 2).Value - 1 If j < 0 Then j = 8 - Cells(i, 2).Value + Cells(i + 1, 2).Value For k = 1 To j Rows(i + k).EntireRow.Insert Next ki = i + k Loop End Sub