VBA

Question

如何浏览特定工作表并在特定列中找到包含单词“防火墙”的每一行 - 然后在上面插入一个空行？带有“firewall”的行后面可能跟有其他值的行。列中的最后一行始终是“总计”。我想可以用作停止循环的条件。

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

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

VBA - Excel insert row above for each cell containing certain text

excel

row

插入行（查找 feat.Union）