VBA-Excel在上面为每个包含特定文本的单元格插入行

Question

如何遍历特定的工作表，并在包含单词"；防火墙"-然后在上面插入一个空行？带有"；防火墙"；后面可能跟有包含其他值的行。列中的最后一行总是"0"；总计"；。我想可以作为停止循环的条件。

我在Stack Overflow上发现了这个例子，这几乎正是我所需要的，但它只做了一次，我需要通过整个列来进行所有匹配。应指定工作表。

Sub NewRowInsert()
Dim SearchText As String
Dim GCell As Range
SearchText = "Original"
Set GCell = Worksheets("Sheet2").Cells.Find(SearchText).Offset(1)
GCell.EntireRow.Insert
End Sub   

我的数据示例：

firewall abc
policy x
policy y 
firewall xyz  
policy z 
policy xxx 
Grand Total

Answer 1

插入行(查找feat.Union(

Option Explicit
Sub NewRowInsert()

Const sText As String = "FirEWaLL"

Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
Dim ws As Worksheet: Set ws = wb.Worksheets("Sheet1")
Dim LastRow As Long: LastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
Dim rg As Range: Set rg = ws.Range("A2:A" & LastRow)
Dim sCell As Range: Set sCell = rg.Find(sText, , xlFormulas, xlPart)

Application.ScreenUpdating = False

Dim trg As Range
Dim sCount As Long

If Not sCell Is Nothing Then
Dim FirstAddress As String: FirstAddress = sCell.Address
Do
If trg Is Nothing Then
Set trg = sCell
Else
Set trg = Union(trg, sCell.Offset(, sCount Mod 2))
End If
sCount = sCount + 1
Set sCell = rg.FindNext(sCell)
Loop Until sCell.Address = FirstAddress
trg.EntireRow.Insert
End If

Application.ScreenUpdating = True

Select Case sCount
Case 0
MsgBox "'" & sText & "' not found.", vbExclamation, "Fail?"
Case 1
MsgBox "Found 1 occurrence of '" & sText & "'.", _
vbInformation, "Success"
Case Else
MsgBox "Found " & sCount & " occurrences of '" & sText & "'.", _
vbInformation, "Success"
End Select
End Sub