VBA - Excel 在每個包含特定文本的單元格上方插入行

Question

您如何 go 通過特定工作表並在包含單詞“防火牆”的每一行的特定列中 - 然后在上面插入一個空行？ 帶有“防火牆”的行后面可能跟着包含其他值的行。 列中的最后一行始終是“總計”。 我想可以用作停止循環的條件。

我在 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

插入行（查找專長。聯合）

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