如果單元格值發生變化，請將粘貼作為值復制到同一單元格

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 的評論：“宏正在針對我在文件中所做的每項更改而運行。如果我更改表 'Mock' 上 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