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

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

我一直从Excel中得到一个错误

无法完成任务。资源错误

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

以下是我的数据：

工作表（“HR计算”）。激活
对于lRow=单元格（Cells.Rows.Count，“A”）。结束（xlUp）。行到6步骤-1
如果单元格（lRow，“A”）单元格（lRow-1，“A”），则
行（lRow）.EntireRow.Insert
行（lRow）.EntireRow.Insert
行（lRow）.EntireRow.Insert
行（lRow）.EntireRow.Insert
如果结束
下一条路

如果您想要一个不那么笨重的was（如您所述），我会默认使用阵列来提高速度。试试下面的代码，看看你的想法。这假设您的数据从第6行开始（如果不是，请在相关数据开始之前将“offset”的值更改为最后一行）。如果您想更改将来插入的行数，只需将rows_to_insert的值更改为所需的数字即可

Sub insertrows()

Dim check_col() As Variant
Dim rng As Range
Dim lcell As Range
Dim i As Long
Dim rows_to_insert As Long
Dim rows_added As Long
Dim offset As Long
Dim insert_cell As Long

Worksheets("HR-Calc").Activate
lrow = Cells(Cells.Rows.Count, "A").End(xlUp).Row
Set lcell = Cells(lrow, 1)
Set rng = Range("A6", lcell)
check_col = rng
rows_to_insert = 4
rows_added = 0
offset = 5

rows_added = 0
For i = 1 To (UBound(check_col, 1) - 1)
    If check_col(i, 1) <> check_col(i + 1, 1) Then
        check_col(i, 1) = i + rows_added + offset
        rows_added = rows_added + rows_to_insert
    Else: check_col(i, 1) = VBnllstring
    End If
Next i
check_col(UBound(check_col, 1), 1) = vbNullString
rows_to_insert = rows_to_insert - 1
For i = 1 To UBound(check_col, 1)
    If check_col(i, 1) <> vbNullString Then
        insert_cell = check_col(i, 1) + 1
        Range(Cells(insert_cell, 1), Cells(insert_cell + rows_to_insert, 1)).EntireRow.Select
        Range(Cells(insert_cell, 1), Cells(insert_cell + rows_to_insert, 1)).EntireRow.Insert
    End If
Next i
End Sub

子插入行（）
Dim check_col（）作为变量
变暗rng As范围
暗淡的lcell As范围
我想我会坚持多久
调暗行\u至\u插入长度
暗行\u添加为长行
变暗偏移等于长
Dim insert_单元长度为
工作表（“HR计算”）。激活
lrow=单元格（Cells.Rows.Count，“A”）。结束（xlUp）。行
设置lcell=单元格（lrow，1）
设置rng=范围（“A6”，lcell）
检查\u col=rng
行\u至\u插入=4
添加的行数=0
偏移量=5
添加的行数=0
对于i=1到（UBound（检查列1）-1）
如果检查列（i，1）检查列（i+1，1），则
检查列（i，1）=i+行添加+偏移
行添加=行添加+行插入
否则：检查_col（i，1）=VBnllstring
如果结束
接下来我
check_col（UBound（check_col，1），1）=vbNullString
行\u至\u插入=行\u至\u插入-1
对于i=1至UBound（检查第1列）
如果检查_col（i，1）vbNullString，则
插入单元格=检查列（i，1）+1
范围（单元格（插入单元格，1），单元格（插入单元格+行到行插入，1））。EntireRow.Select
范围（单元格（插入单元格，1），单元格（插入单元格+行到行插入，1））.EntireRow.insert
如果结束
接下来我
端接头

更整洁的方法是在桌子上使用自动过滤器

（代码假设列A是一个排序的整数ID-从图像中可以看出）

子插入行中间增量（）
将ws设置为工作表：设置ws=工作表（“HR计算”）
变暗头错误与长头错误：头错误=4
Application.ScreenUpdating=False
将LastRow的长度设置为：LastRow=ws.Columns（1）。查找（“*”_
搜索顺序：=xlByRows，搜索方向：=xlPrevious）。行
将LastCol的长度设置为：LastCol=ws.Cells.Find（“*”_
SearchOrder:=xlByColumns，SearchDirection:=xlPrevious）.Column
尺寸Tbl作为范围：设置Tbl=ws.Range（单元格（HeaderRow，1），单元格（LastRow，LastCol））
我和我一样长，我和我一样长
对于i=ws.Cells（LastRow，1）。值为1步骤-1
Tbl.AutoFilter字段：=1，准则1:=i
j=Tbl.SpecialCells（xlCellTypeVisible）.SpecialCells（xlCellTypeLastCell）.行
Tbl.自动过滤器
如果j HeaderRow和j

资源不足是不好的XD您有多少行？您是否尝试过通过调试单步执行代码？我想知道你的代码是否导致了无休止的循环。你应该使用单元格（lRow，1）.Value或范围（“A”&lRow）.Value。单元格采用行号和列号（1,1）输入，范围采用单元格引用A1类型输入，以@findwindow的问题为基础，这取决于您如何声明您可能在那里耗尽空间。整数数据类型只允许-32768和32767之间的数字。因此，如果您有超过32767行，您应该将其声明为Longi发现了问题。我复制了一个单元格区域，它用于查找列中的最后一个单元格，从a100000开始，然后使用xlup查找包含数据的最后一行。我忘了更改100000个单元格，它一次粘贴了大约200万个单元格的数据，因此出现了错误。但是谢谢你的注释，有没有更好的方法来做这个插入？在我看来它仍然很笨重。Col A是位置ID的计数。该ID将每隔一段时间重新启动一次。block1-box1、block1-box2、block1-box3、block2-box1、block2-box2、block3-box1等。每次更改我都插入4行，这样我就不需要为块#运行此宏两次，一次为块#，另一次为块#。是的-这是假定的。。。它按每个块过滤，然后在最后一行下方插入4行（这将是到下一个块的过渡）

Sub insertrows()

Dim check_col() As Variant
Dim rng As Range
Dim lcell As Range
Dim i As Long
Dim rows_to_insert As Long
Dim rows_added As Long
Dim offset As Long
Dim insert_cell As Long

Worksheets("HR-Calc").Activate
lrow = Cells(Cells.Rows.Count, "A").End(xlUp).Row
Set lcell = Cells(lrow, 1)
Set rng = Range("A6", lcell)
check_col = rng
rows_to_insert = 4
rows_added = 0
offset = 5

rows_added = 0
For i = 1 To (UBound(check_col, 1) - 1)
    If check_col(i, 1) <> check_col(i + 1, 1) Then
        check_col(i, 1) = i + rows_added + offset
        rows_added = rows_added + rows_to_insert
    Else: check_col(i, 1) = VBnllstring
    End If
Next i
check_col(UBound(check_col, 1), 1) = vbNullString
rows_to_insert = rows_to_insert - 1
For i = 1 To UBound(check_col, 1)
    If check_col(i, 1) <> vbNullString Then
        insert_cell = check_col(i, 1) + 1
        Range(Cells(insert_cell, 1), Cells(insert_cell + rows_to_insert, 1)).EntireRow.Select
        Range(Cells(insert_cell, 1), Cells(insert_cell + rows_to_insert, 1)).EntireRow.Insert
    End If
Next i
End Sub

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