Question

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim KeyCells As Range
    Set KeyCells = Range("bw1:bw1000")
    If Not Application.Intersect(KeyCells, Range(Target.Address)) Is Nothing Then
    Range(Target.Address).Copy
    Range(Target.Address).PasteSpecial xlPasteValues
    End If
End Sub

Answer 1

将此代码放入ThisWorkbook模块（不是表单模块）：

Private Sub Workbook_SheetCalculate(ByVal Sh As Object)

    Dim KeyCells As Range
    Dim ChangedCell As Range
    Dim OldVal As Variant
    Dim NewVal As Variant

    'Adjust the name of the worksheet to be the name of the actual sheet containing the formulas in column BW
    Set KeyCells = Me.Sheets("Sheet1").Range("BW1:BW1000")

    If Sh.Name = KeyCells.Parent.Name Then
        For Each ChangedCell In KeyCells.Cells
            If ChangedCell.HasFormula Then
                Application.EnableEvents = False
                NewVal = ChangedCell.Value
                Application.Undo
                OldVal = ChangedCell.Value
                Application.Undo
                If NewVal <> OldVal Then ChangedCell.Value = NewVal
                Application.EnableEvents = True
            End If
        Next ChangedCell
    End If

End Sub

修改

来自OP的评论：“我正在为文件中的每个更改运行宏。如果我在工作表'模拟'上更改H57中的值，我可以限制更改被触发吗？”

为此，请从ThisWorkbook模块中删除上述代码，并将以下代码放在“Mock”表单模块中：

Private Sub Worksheet_Change(ByVal Target As Range) Dim KeyCells As Range Dim ChangedCell As Range Dim OldVal As Variant Dim NewVal As Variant If Target.Address = "$H$57" Then Set KeyCells = ThisWorkbook.Sheets("Main.Data").Range("BW1:BW1000") For Each ChangedCell In KeyCells.Cells If ChangedCell.HasFormula Then Application.EnableEvents = False NewVal = ChangedCell.Value Application.Undo OldVal = ChangedCell.Value Application.Undo If NewVal <> OldVal Then ChangedCell.Value = NewVal Application.EnableEvents = True End If Next ChangedCell End If End Sub

如果单元格值更改，请将粘贴复制为相同单元格的值

1 个答案: