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

Question

我正在使用以下 VBA 代码插入空白行，其中 excel 中缺少顺序值。

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

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

4
5
但是，如果缺少最后一个值 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 k 
    i = i + k 
Loop 
End Sub

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

Insert row where sequential value is missing, Excel VBA

excel

vba

ms-office

sequential