excel - 具有动态范围/边界的循环

Question

我想使用下面的代码循环遍历一系列单元格并检查“测试字”是否在其中一个单元格中。如果是，则插入新行并将下面的所有单元格向下移动一个单元格。现在的问题是，我正在使用 j = Range("A:A").End(xlDown).Row确定for循环的第二个计数器，并且每次找到“Testword”时，该计数器不会随着通过插入新行的移动而改变。因此，必须检查值的单元格会超出边界并“错过”循环。

Sub Macro1()

    Dim i As Integer
    Dim j As Integer
        
    j = Range("A:A").End(xlDown).Row

    For i = 1 To j

        If Range("A" & i) = "Testword" Then
            Range("A" & i + 1).Insert
    
        End If
    
    Next i

End Sub

Answer 1

请尝试下一个方法。它将是 更快 ，在最后插入所有内容，一次:

Sub Macro1()
    Dim i As Long, j As Long, rngIns As Range
        
    j = Range("A" & rows.count).End(xlUp).row 'it will work even with gaps in A:A column

    For i = 1 To j
        If Range("A" & i) = "Testword" Then
            If rngIns Is Nothing Then
                Set rngIns = Range("A" & i + 1)
            Else
                Set rngIns = Union(rngIns, Range("A" & i + 1))
            End If
        End If
    Next i
    If Not rngIns Is Nothing Then
        'solving cases of consecutive rows keeping the searched string:
        If InStr(rngIns.Address(0, 0), ":") > 0 Then _
                   Set rngIns = makeDiscontinuu(rngIns)
        rngIns.EntireRow.Insert
    End If
End Sub

Function makeDiscontinuu(rng As Range) As Range
   Dim a As Range, c As Range, strAddress As String
   For Each a In rng.Areas
        If a.cells.count = 1 Then
            strAddress = strAddress & a.Address(0, 0) & ","
        Else
            For Each c In a.cells
                strAddress = strAddress & c.Address(0, 0) & ","
            Next c
        End If
   Next a
   Set makeDiscontinuu = Range(left(strAddress, Len(strAddress) - 1))
End Function