Excel 循环遍历范围并插入行

我在a列中有一个按标题分组的大型数据集。我想循环A10:A600，每次找到标题“US 1”时，在上面插入一个新行。然后我希望它继续循环到下一个实例，以此类推

我已经尝试了下面的代码，它查找值并插入行。但是，它会在第一个实例中不断插入无限多的行，而不是移动到“US 1”的下一个实例

我希望它在“US 1”的每个实例上方添加一行，但它仅在第一个实例上方添加无限行。

这将起作用：

Sub US_1()

Dim i As Integer

For i = 10 To 600

 If Range("A" & i).Value = "US 1" Then
    Range("A" & i).EntireRow.Select
    Selection.Insert Shift:=xlDown
    i = i + 1
 End If

Next

End Sub

---

您正以正确的方式插入行，但在插入时，行向下移动，因此您的循环被卡在同一单元格上。

问题是，在读取A10并插入行后，程序会继续查找A11。但是A11是A10的内容现在所在的位置（因为它由于插入而向下移动）。尝试自己增加索引，如果插入一行，则再增加一个索引

Option Explicit

Sub test()

    Dim i  As Long

    'Change name if needed
    With ThisWorkbook.Worksheets("Sheet1")

        For i = 600 To 10 Step -1
            If .Range("A" & i).Value = "US 1" Then
                .Rows(i).EntireRow.Insert
            End If
        Next i
    End With

End Sub

Sub US_1()
    Set Rng = Range("A10:A600")
    For rowNr = Rng.Row To Rng.Row + Rng.Rows.Count - 1
        For colNr = Rng.Column To Rng.Column + Rng.Columns.Count - 1
            Set cell = Cells(rowNr, colNr)
            If cell.Value = "US 1" Then
                cell.EntireRow.Select
                Selection.Insert Shift:=xlDown
                rowNr = rowNr + 1
            End If
        Next colNr
    Next rowNr
End Sub

---

谢谢你的回复！当我输入以上内容时，我在cell.Value=“US 1”上得到一个类型不匹配错误-知道为什么吗？提前感谢在我的Excel中它工作正常。请尝试使用cell.Text=“US 1”也许这样可以

Sub US_1()
    Set Rng = Range("A10:A600")
    For rowNr = Rng.Row To Rng.Row + Rng.Rows.Count - 1
        For colNr = Rng.Column To Rng.Column + Rng.Columns.Count - 1
            Set cell = Cells(rowNr, colNr)
            If cell.Value = "US 1" Then
                cell.EntireRow.Select
                Selection.Insert Shift:=xlDown
                rowNr = rowNr + 1
            End If
        Next colNr
    Next rowNr
End Sub

Sub US_1()
    Dim rng As Range
    Dim cell As Range
    Dim LAstRow As Long

    Set rng = Range("A10:A600")
    LAstRow = 0
    For Each cell In rng.Cells
        If cell.Value = "US 1" Then
             If cell.Row > LAstRow Then
                 cell.EntireRow.Insert Shift:=xlDown
                 LAstRow = cell.Row
             End If
       End If
    Next cell
End Sub