4

我想知道如何在具有“订单类型”（如下所示）的指定行上方插入 3 个额外的行。

此行在工作表中出现多次。下面的代码有效，除了它在指定行下方插入行。谢谢

Sub try()
    Dim c As Range

    For Each c In Range("A1:A100")
        If c.Value Like "*Order Type*" Then
            c.Offset(3, 0).EntireRow.Insert
        End If
    Next c
End Sub
4

2 回答 2

4

如果您的问题是在搜索条件之上添加 3 个额外的行，那么解决您的问题应该很容易：

在您的代码行中：

c.Offset(3, 0).EntireRow.Insert

您的行说，当找到订单类型时，他应该在下面 3 行并插入额外的行。

应该是这样的：

c.EntireRow.Resize(3).Insert

我的行说，当找到订单类型时，在其上方添加 3 个额外的行。

希望这就是你要找的。

编辑：

我已经在互联网上搜索并找到了与您的问题类似的内容，并根据您的需要进行了更改。希望这对你有用。很少解释它是如何工作的：它一直搜索 A 列，如果找到“订单类型”，它会在其上方添加 3 行。当宏进入空白单元格时，它会停止。试试看，告诉我它是否对你有用。

Sub AddRows()

Dim lastValue As String, i As Long, r As Long
Do
    r = r + 1
    If r > 1 And Cells(r, 1).Value Like "*Order Type*" Then
        If Cells(r, 1).Value = "" Then Exit Do
        For i = 1 To 3
            Rows(r).Insert Shift:=xlUp
        Next
        r = r + 3

        Else
            If IsEmpty(Cells(r, 1)) = True Then
            Exit Do

            Else

            End If

    End If
    lastValue = Cells(r, 1).Value
Loop

End Sub
于 2013-07-25T08:02:05.697 回答
1

这应该上升三行而不是下降三行：

c.Offset(-3, 0).EntireRow.Insert

请谨慎使用，因为如果当前行上方没有三行，则会引发错误。一个更安全的方法是从当前行插入 + 2 并将所有内容向下移动。

Rows(c.Row & ":" & c.Row + 2).EntireRow.Insert Shift:=xlDown

编辑：它运行直到 excel 冻结的原因是由于您的循环的构造方式。第一次找到匹配项时，它会插入行，然后继续查找相同的匹配项，导致它陷入无限循环。

你可以试试这个，看看它是否符合你的要求，它对我有用。

Sub try()
    Dim i As Long
    Dim c As Range

    Do While i < ActiveSheet.UsedRange.Rows.Count
        i = i + 1
        Set c = Cells(i, 1)

        If c.Value Like "*Order Type*" Then
            Rows(c.Row & ":" & c.Row + 2).EntireRow.Insert Shift:=xlDown
            i = i + 3
        End If
        Debug.Print i
    Loop
End Sub
于 2013-07-24T19:59:05.390 回答