在 Col A 中查找更改并使用 Excel VBA 插入 4 行答案

【问题标题】：Find change in Col A and insert 4 rows using Excel VBA在 Col A 中查找更改并使用 Excel VBA 插入 4 行
【发布时间】：2015-10-01 04:55:53
【问题描述】：

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

我不断收到来自 Excel 的错误，

无法完成任务。资源错误

然后range类的一个runtime 1004 insert方法失败，调试器高亮插入行的代码

这是我的数据的样子：

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

【问题讨论】：

资源耗尽是不好的 XD 你有多少行？
您是否尝试过通过调试单步执行代码？我想知道您的代码是否以某种方式导致了无限循环。
您应该使用 Cells(lRow,1).Value 或 Range("A" & lRow).value。 Cells 采用行号和列号 (1,1) 输入，Range 采用 Cell Reference A1 类型输入
另外，以@findwindow 的问题为基础，这取决于您如何声明 lRow 可能会用完那里的空间。整数数据类型只允许介于 -32768 和 32767 之间的数字。因此，如果行数超过 32767，则应将其声明为 Long
我发现了问题。我有一个复制的单元格范围，它用于查找列中的最后一个单元格并从 a100000 开始，然后使用 xlup 查找最后一行数据。我忘了更改那 100,000 个，它一次粘贴了大约 200 万个数据单元，因此出现了错误。但是感谢您的注释，有没有更好的方法来做这个插入？它在我看来仍然很笨重。

标签： excel insert vba

【解决方案1】：

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

（代码假定 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

【讨论】：

Col A 是位置 ID 的计数。 ID 将每隔一段时间重新启动一次。 block1 box1、block1 box2、block1 box3、block2 box 1 block 2 box2、block3 box1 等等。我每次更改都插入 4 行，这样我就不需要为 block # 运行此宏两次，然后再为框#。
是的 - 这是假设的......它按每个块过滤#然后在最后一行下方插入 4 行（这将是到下一个块的过渡#）

【解决方案2】：

如果你想要一个不那么笨重的 was（正如你提到的），我会默认使用数组来提高速度。试试下面的代码，看看你的想法。这假设您的数据从第 6 行开始（如果不是，请将“偏移”的值更改为相关数据开始之前的最后一行）。如果要更改将来插入的行数，只需将 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

【讨论】：