Excel VBAmacros代码插入无限制的行而不停止

下面的代码在指定列中的单元格更改并且不为空时自动运行。

Sub mergeCells() Dim num As Integer Dim countmerged As Integer If IsEmpty(ActiveCell.Value) Then Exit Sub Else countmerged = -1 If ActiveCell.Offset(-1, 0).mergeCells Then countmerged = ActiveCell.Offset(-1, 0).MergeArea.Cells.Count * -1 End If num = ActiveCell.Offset(countmerged, -1).Value If ActiveCell.Offset(countmerged, 0).Value = ActiveCell.Value Then ActiveCell.ClearContents ActiveCell.Offset(0, 1).ClearContents ActiveCell.Offset(0, 37).ClearContents ActiveCell.Offset(0, 36).ClearContents ActiveCell.Offset(0, -1).ClearContents ActiveCell.Offset(1, 0).EntireRow.Insert ActiveCell.Offset(2, 0).EntireRow.Copy ActiveCell.Offset(1, 0).EntireRow Range(ActiveCell.Offset(countmerged, 37), ActiveCell.Offset(0, 37)).Merge Range(ActiveCell.Offset(countmerged, 36), ActiveCell.Offset(0, 36)).Merge Range(ActiveCell.Offset(0, 1), ActiveCell.Offset(countmerged, 1)).Merge Range(ActiveCell.Offset(countmerged, -1), ActiveCell.Offset(0, -1)).Merge Range(ActiveCell, ActiveCell.Offset(countmerged, 0)).Merge ActiveCell.Offset(1, -1).Value = num + 1 ActiveCell.Offset(2, -1).Value = num + 2 Else ActiveCell.Offset(1, 0).EntireRow.Insert ActiveCell.Offset(2, 0).EntireRow.Copy ActiveCell.Offset(1, 0).EntireRow Selection.Offset(1, -1).Value = num + 2 Selection.Offset(2, -1).Value = num + 3 End If End If End Sub 

如果值与上面的单元格的值相同，则将合并它们，并插入具有相同公式的另一行。 这工作没有问题。

但是，如果值与上面的单元格不同，则只有一行必须使用相同的公式插入，但是它会在不停止的情况下添加行。

Answer 1

我不认为你是向我们展示了代码的重要部分（这一点）。

我会尝试禁用事件，因为macros可能会改变一个单元格，并看到一个单元格被改变（插入，无论）再次开始你的事件。

尝试在macros的开始和结尾添加这些内容。

 Application.EnableEvents = False Application.EnableEvents = True