Question

当指定列中的单元格发生更改且不为空时，将自动运行以下代码。

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

我认为您没有向我们展示代码的重要部分（将其设置为关闭部分）。

我会尝试禁用事件，因为宏可能会更改一个单元格并看到一个单元格被更改（插入，无论如何）再次启动您的事件。

尝试在宏的开头和结尾添加这些内容。

Application.EnableEvents = False  


Application.EnableEvents = True

Excel VBA宏代码插入无限行而不停止

1 个答案: