Question

我有一个在更改单元格时运行的If语句。这部分工作正常。但是，当它运行宏时，由于某种原因，它增加了大约40个额外的行。我使用断点并发现在粘贴特殊之后添加了行。谁能告诉我为什么？

提前致谢。

Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Address = "$AG$4" Then

Call CapEx_Copy_Paste_Delete

End If

End Sub

Sub CapEx_Copy_Paste_Delete()
'
' CapEx_Copy_Paste_Delete Macro
'

'
    Rows("11:11").Select

    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("B4:AG4").Select
    Selection.Copy
    Range("B11").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("AG4").Select
    Selection.ClearContents
    Range("B4:E4").Select
    Selection.ClearContents
    Range("H4:I4").Select
    Selection.ClearContents
    Range("L4:M4").Select
    Selection.ClearContents
    Range("P4:Q4").Select
    Selection.ClearContents
    Range("T4:U4").Select
    Selection.ClearContents
    Range("X4:Y4").Select
    Selection.ClearContents
    Range("Z4").Select
    Selection.ClearContents
    Range("AA4").Select
    Selection.ClearContents
    Range("AC4").Select
    Selection.ClearContents
    Range("AD4").Select
    Selection.ClearContents
    Range("B4").Select
End Sub

Answer 1

这有效吗？：

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Address = "$AG$4" Then
        Application.EnableEvents = False
            Call CapEx_Copy_Paste_Delete
        Application.EnableEvents = True
    End If
End Sub

Answer 2

以下是您的代码的整洁版本。使用Select的所有内容都可能无法解决您的问题：

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Address = "$AG$4" Then
        Application.EnableEvents = False
            Call CapEx_Copy_Paste_Delete
        Application.EnableEvents = True
    End If
End Sub

Sub CapEx_Copy_Paste_Delete()
    Dim ws As Worksheet
    Dim arrRanges As Variant, v As Variant

    'set this as the worksheet you want to update
    Set ws = ThisWorkbook.Worksheets("Sheet1")

    'set this as the ranges you want to clear
    arrRanges = Array("AG4", "B4:E4", "H4:I4", "L4:M4", "P4:Q4", "T4:U4", "X4:Y4", "Z4")

    With ws
        .Rows("11:11").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove

        .Range("B4:AG4").Copy
        .Range("B11").PasteSpecial Paste:=xlPasteValues

        For Each v In arrRanges
            .Range(v).ClearContents
        Next v
    End With
End Sub

<小时/> 更新以包含加里学生的建议 - 所有信用都归功于他建议你在第一个子

中禁用事件

在更改目标地址时运行宏

2 个答案: