excel - 查找 A 列中的更改并使用 Excel VBA 插入 4 行

Question

我试图让我的代码每次在下面的单元格中发现差异时插入四行。如果 A5-55 = 1、A56-80 = 2、A81 - 100 = 3 我希望代码看到 56 不等于 55 并插入 4 行，然后继续沿着 A 列向下移动，直到没有更多值。

我不断收到 Excel 错误，

can not complete task. Resources error

然后 range 类的运行时 1004 插入方法失败，调试器突出显示插入行的代码

这就是我的数据:

Worksheets("HR-Calc").Activate
For lRow = Cells(Cells.Rows.Count, "A").End(xlUp).Row To 6 Step -1

If Cells(lRow, "A") <> Cells(lRow - 1, "A") Then
            Rows(lRow).EntireRow.Insert
            Rows(lRow).EntireRow.Insert
            Rows(lRow).EntireRow.Insert
            Rows(lRow).EntireRow.Insert
End If
Next lRow

Answer 1

更简洁的方法是在 table 上使用自动过滤器

(代码假设 A 列是一个排序的整数 ID - 正如图像中的情况)

Sub InsertRowsBetweenIncrements()

    Dim ws As Worksheet: Set ws = Worksheets("HR-Calc")
    Dim HeaderRow As Long: HeaderRow = 4

    Application.ScreenUpdating = False

        Dim LastRow As Long: LastRow = ws.Columns(1).Find("*", _
            SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
        Dim LastCol As Long: LastCol = ws.Cells.Find("*", _
            SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
        Dim Tbl As Range: Set Tbl = ws.Range(Cells(HeaderRow, 1), Cells(LastRow, LastCol))
        Dim i As Long, j As Long

        For i = ws.Cells(LastRow, 1).Value To 1 Step -1
            Tbl.AutoFilter Field:=1, Criteria1:=i
            j = Tbl.SpecialCells(xlCellTypeVisible).SpecialCells(xlCellTypeLastCell).Row
            Tbl.AutoFilter
            If j <> HeaderRow And j < LastRow Then _
                ws.Rows(j + 1 & ":" & j + 4).Insert Shift:=xlDown
        Next i

    Application.ScreenUpdating = True

End Sub