vba 在指定行上方插入行
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/17843461/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
Inserting rows above a specified rows
提问by user2616026
I am wondering how to insert 3 extra rows above a specified row that has "order type" (as specified below).
我想知道如何在具有“订单类型”（如下所述）的指定行上方插入 3 个额外的行。
This row occurs multiple times in the sheet. The below code works, except it inserts the rows below the specified row. Thanks
此行在工作表中多次出现。下面的代码有效，除了它插入指定行下方的行。谢谢
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
回答by lowak
If your problem is to add 3 extra rows above searched criteria, solving your problem should be easy:
如果您的问题是在搜索条件上方添加 3 行，那么解决您的问题应该很容易：
In you code line:
在你的代码行中：
c.Offset(3, 0).EntireRow.Insert
Your line says when order type is found he should go 3 rows below and insert extra row.
您的行说，当找到订单类型时，他应该往下走 3 行并插入额外的行。
Should go like this:
应该是这样的：
c.EntireRow.Resize(3).Insert
My line says, when order type is found, add 3 extra rows above it.
我的行说，当找到订单类型时，在它上面添加 3 行。
Hope this is what you looking for.
希望这就是你要找的。
Edited:
编辑：
I've searched Internet and found something similar to your problem and changed it according to you needs. Hope this will work for you. Little explanation how it works: it searches all the way through A column and if "Order Type" was found it adds 3 rows above it. When macro goes to blank cell it stops. Try it and tell me if it works good for you.
我在互联网上搜索并发现了与您的问题类似的东西，并根据您的需要进行了更改。希望这对你有用。几乎没有解释它是如何工作的：它一直搜索 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
回答by Ripster
This should go up three rows instead of down three:
这应该上升三行而不是下降三行：
c.Offset(-3, 0).EntireRow.Insert
Use caution with this because if there are not three rows above the current row it will throw an error. A safer way to do this is by inserting from the current row + 2 more and shifting everything down.
请谨慎使用，因为如果当前行上方没有三行，它将引发错误。一种更安全的方法是从当前行插入 + 2 个并将所有内容向下移动。
Rows(c.Row & ":" & c.Row + 2).EntireRow.Insert Shift:=xlDown
Edit:The reason it runs until excel freezes is due to the way your loop is constructed. The first time it finds a match it inserts rows and then continues on finds the same match again causing it to get stuck in an infinite loop.
编辑：它运行直到 excel 冻结的原因是由于您的循环的构造方式。第一次找到匹配项时，它插入行，然后继续找到相同的匹配项，导致它陷入无限循环。
You can try this and see if it does what you want, it worked for me.
你可以试试这个，看看它是否符合你的要求，它对我有用。
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
