Question

我希望在工作表中的每个HDR实例后插入一个新的空白行。我无法弄清楚如何让代码超越第一个实例继续完成工作表的其余部分。

 Sub NewRowInsert()

    Dim SearchText As String
    Dim GCell As Range

    SearchText = "HDR"
    Set GCell = Cells.Find(SearchText).Offset(1)
    GCell.EntireRow.Insert


 End Sub

Answer 1

试试此代码

Sub Test()
Dim a()         As Variant
Dim found       As Range
Dim fStr        As String
Dim fAdd        As String
Dim i           As Long

fStr = "HDR"
Set found = Cells.Find(What:=fStr, After:=Range("A1"), LookIn:=xlValues, LookAt:=xlWhole)

If Not found Is Nothing Then
    fAdd = found.Address

    Do
        ReDim Preserve a(i)
        a(i) = found.Offset(1).Address
        i = i + 1
        Set found = Cells.FindNext(found)
    Loop Until found.Address = fAdd
End If

If i = 0 Then Exit Sub
For i = UBound(a) To LBound(a) Step -1
    Range(a(i)).EntireRow.Insert
Next i
End Sub

另一个选择

Sub Test()
Dim a()         As Variant
Dim oRange      As Range
Dim found       As Range
Dim fStr        As String
Dim fAdd        As String

fStr = "HDR"
Set found = Cells.Find(What:=fStr, After:=Range("A1"), LookIn:=xlValues, LookAt:=xlWhole)

If Not found Is Nothing Then
    fAdd = found.Address

    Do
        If oRange Is Nothing Then Set oRange = found.Offset(1) Else Set oRange = Union(oRange, found.Offset(1))
        Set found = Cells.FindNext(found)
    Loop Until found.Address = fAdd
End If

If Not oRange Is Nothing Then oRange.EntireRow.Insert
End Sub

Answer 2

Sub NewRowInsert()

    Dim SearchText As String
    Dim GCell As Range
    Dim NumSearches As Integer
    Dim i As Integer

    SearchText = "HDR"
    NumSearches = WorksheetFunction.CountIf(Cells, SearchText)
    Set GCell = Cells(1, 1)

    For i = 1 To NumSearches

        Set GCell = Cells.Find(SearchText, After:=GCell, SearchOrder:=xlByRows, SearchDirection:=xlNext).Offset(1)
        GCell.EntireRow.Insert

    Next i


 End Sub

在每个特定文本实例后插入一行

2 个答案: