符合条件时循环不会结束

Question

我有一个名为＆＃34的工作表;小计＆＃34;我在哪里确定要用1＆amp;减去的2行2（与＆＃34; 2＆＃34;与＃34; 1＆＃34;中的行相减;我需要在＆＃34; 2＆＃34;线下方插入一行。为了在所需的单元格中添加正确的公式。 我选择包含条件（1,2）的列，然后为＆＃34; 2＆＃34;执行查找命令，然后使用offset属性选择下面的单元格并插入一行。这很好用，但是当我应用循环时它不会停止。我已经指出，如果活动单元格=＆＃34; 2XXXXX＆＃34;然后退出Do.我已经尝试了几种变化，最终得到了相同的无限循环。谁能告诉我我做错了什么？ 这是我的代码：

  Sub insert_row_1()
    '
     Range("D1").Select
        Selection.End(xlDown).Activate
        ActiveCell.Offset(1, 0).Activate
        ActiveCell.FormulaR1C1 = "2XXXXX"
    Range("A1").Select

        Columns("D:D").Select
       Selection.Find(What:="2", After:=ActiveCell, LookIn:=xlValues, LookAt:= _
            xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:= _
            False, SearchFormat:=False).Activate


     Do
      If ActiveCell.Value = "2" Then
       ActiveCell.Offset(1, 0).Activate
        ActiveCell.EntireRow(1).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove

      ElseIf ActiveCell.Value <> "2" Then

       With Columns("D")

       Selection.FindNext(After:=ActiveCell).Activate
        ActiveCell.Offset(1, 0).Activate
        ActiveCell.EntireRow(1).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
        End With


    ElseIf ActiveCell.Value = "2XXXXX" Then
    Exit Do
    End If



    Loop


    End Sub

Answer 1

不幸的是，我无法让你的循环工作，但是，如果我正确理解你的目标，可能有一种更简单的方法来完成你需要的东西。

据我所知，你想：

1. 在列D
中的每一行的每一行下方插入一行
2. 在新行的E列中，从E列上方的值中减去新行上方一列的E列值。

以下内容将实现：

Sub InsertAfter2()
For Each Cell In Range("D:D")
If Cell.Row <> 1 Then
If (Cells(Cell.Row - 1, 4).Value = 2) Then
Cell.EntireRow(1).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Cells(Cell.Row - 1, 4).Value = "Result:"
Cells(Cell.Row - 1, 5).Value = (Cells(Cell.Row - 3, 5).Value) - (Cells(Cell.Row - 2, 5).Value)
End If
End If
Next Cell
End Sub

这将采用如下数据：



并生成如下所示的数据：