Question

我有以下代码在F2：F251中的值发生更改时执行，但它没有正确执行（或者，更可能是我写错了）。

当F2：F251在活动工作表中更改时，1月到12月的工作表A2：F251的内容应该复制到主工作表，以便新数据或已更改的旧数据始终是最新的主表。

但是，会发生的事情是活动工作表中的数据被覆盖，最终导致无限循环。这是自动运行代码的问题，还是复制代码的问题？单独执行，在命令上，在主表上执行的复制代码正常运行。此外，这似乎是一种执行我想要的动作的相当冗长的方式。是否有一种更有效的明显替代方案？

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim KeyCells As Range

    ' The variable KeyCells contains the cells that will
    ' cause an alert when they are changed.
    Set KeyCells = Range("F1:F251")

    If Not Application.Intersect(KeyCells, Range(Target.Address)) _
           Is Nothing Then

        ' Copies contents A2:G251 from each monthly
        ' sheet to master record sheet.

        Sheets("MasterRecord").Activate
        Sheets("MasterRecord").Cells.ClearContents

        Dim NextRow As Range
        Set NextRow = Range("A" & Sheets("MasterRecord").UsedRange.Rows.Count + 1)
        Sheets("January").Range("A2:G251").Copy
        Sheets("MasterRecord").Activate
        NextRow.PasteSpecial Paste:=xlValues, Transpose:=False
        Application.CutCopyMode = False
        Set NextRow = Nothing

        Set NextRow = Range("A" & Sheets("MasterRecord").UsedRange.Rows.Count + 1)
        Sheets("February").Range("A2:G251").Copy
        Sheets("MasterRecord").Activate
        NextRow.PasteSpecial Paste:=xlValues, Transpose:=False
        Application.CutCopyMode = False
        Set NextRow = Nothing

        Set NextRow = Range("A" & Sheets("MasterRecord").UsedRange.Rows.Count + 1)
        Sheets("March").Range("A2:G251").Copy
        Sheets("MasterRecord").Activate
        NextRow.PasteSpecial Paste:=xlValues, Transpose:=False
        Application.CutCopyMode = False
        Set NextRow = Nothing

        Set NextRow = Range("A" & Sheets("MasterRecord").UsedRange.Rows.Count + 1)
        Sheets("April").Range("A2:G251").Copy
        Sheets("MasterRecord").Activate
        NextRow.PasteSpecial Paste:=xlValues, Transpose:=False
        Application.CutCopyMode = False
        Set NextRow = Nothing

        Set NextRow = Range("A" & Sheets("MasterRecord").UsedRange.Rows.Count + 1)
        Sheets("May").Range("A2:G251").Copy
        Sheets("MasterRecord").Activate
        NextRow.PasteSpecial Paste:=xlValues, Transpose:=False
        Application.CutCopyMode = False
        Set NextRow = Nothing

        Set NextRow = Range("A" & Sheets("MasterRecord").UsedRange.Rows.Count + 1)
        Sheets("June").Range("A2:G251").Copy
        Sheets("MasterRecord").Activate
        NextRow.PasteSpecial Paste:=xlValues, Transpose:=False
        Application.CutCopyMode = False
        Set NextRow = Nothing

        Set NextRow = Range("A" & Sheets("MasterRecord").UsedRange.Rows.Count + 1)
        Sheets("July").Range("A2:G251").Copy
        Sheets("MasterRecord").Activate
        NextRow.PasteSpecial Paste:=xlValues, Transpose:=False
        Application.CutCopyMode = False
        Set NextRow = Nothing

        Set NextRow = Range("A" & Sheets("MasterRecord").UsedRange.Rows.Count + 1)
        Sheets("August").Range("A2:G251").Copy
        Sheets("MasterRecord").Activate
        NextRow.PasteSpecial Paste:=xlValues, Transpose:=False
        Application.CutCopyMode = False
        Set NextRow = Nothing

        Set NextRow = Range("A" & Sheets("MasterRecord").UsedRange.Rows.Count + 1)
        Sheets("September").Range("A2:G251").Copy
        Sheets("MasterRecord").Activate
        NextRow.PasteSpecial Paste:=xlValues, Transpose:=False
        Application.CutCopyMode = False
        Set NextRow = Nothing

        Set NextRow = Range("A" & Sheets("MasterRecord").UsedRange.Rows.Count + 1)
        Sheets("October").Range("A2:G251").Copy
        Sheets("MasterRecord").Activate
        NextRow.PasteSpecial Paste:=xlValues, Transpose:=False
        Application.CutCopyMode = False
        Set NextRow = Nothing

        Set NextRow = Range("A" & Sheets("MasterRecord").UsedRange.Rows.Count + 1)
        Sheets("November").Range("A2:G251").Copy
        Sheets("MasterRecord").Activate
        NextRow.PasteSpecial Paste:=xlValues, Transpose:=False
        Application.CutCopyMode = False
        Set NextRow = Nothing

        Set NextRow = Range("A" & Sheets("MasterRecord").UsedRange.Rows.Count + 1)
        Sheets("December").Range("A2:G251").Copy
        Sheets("MasterRecord").Activate
        NextRow.PasteSpecial Paste:=xlValues, Transpose:=False
        Application.CutCopyMode = False
        Set NextRow = Nothing

    End If
End Sub

Answer 1

给这一点。

最重要的是，请注意如果满足条件，我将如何禁用事件（然后在代码完成时启用它们）。如果您不关闭事件，每次将新数据粘贴到工作表中时，它都会触发更改事件，在这种情况下您不需要。

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim KeyCells As Range

    ' The variable KeyCells contains the cells that will
    ' cause an alert when they are changed.
    Set KeyCells = Range("F1:F251")

    If Not Application.Intersect(KeyCells, Range(Target.Address)) Is Nothing Then

        ' Copies contents A2:F251 from each monthly
        ' sheet to master record sheet.
        Application.EnableEvents = False

        Dim wsMR As Worksheet
        Set wsMR = ThisWorkbook.Worksheets("MasterRecord")

        wsMR.Cells.ClearContents

        Dim ws As Worksheet
        For Each ws In ThisWorkbook.Worksheets

            Select Case ws.Name


                 Case Is = "January", "February", "March", "April", _
                        "May", "June", "July", "August", "September", _
                        "October", "November", "December"

                    Dim NextRow As Long
                    NextRow = wsMR.Range("A" & wsMR.Rows.Count).End(xlUp).Row + 1
                    ws.Range("A2:G251").Copy
                    wsMR.Range("A" & NextRow).PasteSpecial xlPasteValues

                End Select
        Next

        Application.EnableEvents = True

    End If

End Sub

Answer 2

回答实际问题 - 你的代码进入无限循环的原因有两个原因：

您尚未在活动中停用活动，因此通过粘贴范围F2:F251，您会一次又一次地触发事件。
您正在获取MasterRecord的最后一行，但您使用MasterRecord上的Range ，而不是事件被触发的工作表。

您必须确保在处理使用期望工作表范围的范围时。由于所有工作表都只是对象，因此在Sheet模块中调用Range默认为Me.Range，因此使用工作表。

我相信以下内容可以完成您的需要，而不会重复：

Option Explicit

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)

    '   Target is already a range, no need to get the address explicitly
    If (Intersect(Target, Sh.Range("F1:F251")) Is Nothing) Then Exit Sub

    Application.EnableEvents = False
    Application.ScreenUpdating = False

    Dim master As Worksheet: Set master = ThisWorkbook.Worksheets("MasterRecord")
    Dim ws As Worksheet
    Dim sheets As Variant: sheets = Array("January", "February", "March", "April", "May", "June", "July", "August", "September", "October", "November", "December")
    Dim sheet As Variant

    master.Cells.ClearContents

    For Each sheet In sheets
        Set ws = ThisWorkbook.Worksheets(sheet)
        ws.Range("A2:G251").Copy
        master.Range("A" & master.Range("A" & master.Rows.Count).End(xlUp).Row + 1).PasteSpecial xlPasteValues
    Next

    Set master = Nothing
    Set ws = Nothing

    Application.EnableEvents = True
    Application.ScreenUpdating = True

End Sub

修改

如果您希望在所有工作表上发生这种情况，那么唯一需要更改的是将其置于Workbook_SheetChange模块中的ThisWorkbook方法中。请注意，顶部附近不再有Me.Range，而是Sh.Range。由于工作表正在调用此方法，因此我认为使用Sh.Range vs Range会产生很大的影响，但它永远不会受到伤害。

当活动工作表列中的任何单元格发生更改时，执行Excel宏将所有工作表复制到主工作表

2 个答案:

修改