Question

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

我尝试了下面的代码，该代码查找值并插入行。但是，它会在第一个实例中不断插入无数行，而不是继续到“ US 1”的下一个实例。

Sub US_1()

Set rng = Range("A10:A600")

For Each cell In rng.Cells
 If cell.Value = "US 1" Then
 cell.EntireRow.Select
 Selection.Insert Shift:=xlDown

 End If

Next cell

End Sub

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

Answer 1

问题在于，读取A10并插入一行后，程序将恢复在A11中的查找。但是A11是现在A10的内容所在的地方（因为由于插入而使它移位了）。尝试自己增加索引，如果插入一行，再增加一个。

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

Answer 2

这将起作用：

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

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

Answer 3

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

Answer 4

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

遍历范围并插入行

4 个答案: