VBA Excel - 通过 VBA 代码修改单元格上的数据

Question

我已经编写了一些 VBA 代码到以下内容：

1. 假设我有一个包含这些列的电子表格

[Cost1] [Cost2] [Cost3] [TotalCost] [Margin%] [Margin$] [Price]

1. 如果用户修改成本，总成本和 Margin$ 和 Price 会发生变化，因为它们取决于成本和 Margin%
2. 如果用户修改价格，成本不会改变，但 Margin% 和 Margin$ 会改变，因为它们取决于新价格。

我无法将受保护的公式添加到价格列，因为用户可能想要更改该值，因此公式将被删除。所以我决定编写 VBA 代码，它可以完美地计算。但是，我失去了一些 excel 最有价值的功能：例如如果想要将一个价格的值复制到其他几行，它只会触发复制它的第一行的重新计算，但不会触发其他行的重新计算。退出牢房后我也失去了UNDO的能力。

为了检测单元格是否被修改，我使用了以下内容：

Private Sub Worksheet_Change(ByVal Target As Range)
  If (Target.Column = Range("Price").Column)                 
    Call calcMargins(Target.Row)
  End If

  If (Target.Column = Range("Cost1").Column) or _
  If (Target.Column = Range("Cost2").Column) or _
  If (Target.Column = Range("Cost3").Column) or
    Call calcMargins(Target.Row)
    Call calcPrice(Target.Row)
  End If

Answer 1

试试这个

我特意将代码分解为几个 If 语句和重复代码，以便理解透视。例如

        Cells(Target.Row, 4) = "Some Calculation"               '<~~ TotalCost Changes
        Cells(Target.Row, 6) = "Some Calculation"               '<~~ Margin$ Changes
        Cells(Target.Row, 7) = "Some Calculation"               '<~~ Price Changes

请把它们放在一个共同的过程中。

还要注意Error Handling 和Application.EnableEvents 的使用。在使用Worksheet_Change 时，这两个是必须。 Application.EnableEvents = False 确保代码不会进入可能无限循环，以防出现递归操作。 Error Handling 不仅可以处理错误，还可以通过向您显示错误消息然后将Application.EnableEvents 重置为True 并最终优雅地退出代码来阻止代码分解。

代码

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    On Error GoTo Whoa

    Application.EnableEvents = False

    If Not Intersect(Target, Columns(1)) Is Nothing Then        '<~~ When Cost 1 Changes
        Cells(Target.Row, 4) = "Some Calculation"               '<~~ TotalCost Changes
        Cells(Target.Row, 6) = "Some Calculation"               '<~~ Margin$ Changes
        Cells(Target.Row, 7) = "Some Calculation"               '<~~ Price Changes

    ElseIf Not Intersect(Target, Columns(2)) Is Nothing Then    '<~~ When Cost 2 Changes
        Cells(Target.Row, 4) = "Some Calculation"               '<~~ TotalCost Changes
        Cells(Target.Row, 6) = "Some Calculation"               '<~~ Margin$ Changes
        Cells(Target.Row, 7) = "Some Calculation"               '<~~ Price Changes

    ElseIf Not Intersect(Target, Columns(3)) Is Nothing Then    '<~~ When Cost 3 Changes
        Cells(Target.Row, 4) = "Some Calculation"               '<~~ TotalCost Changes
        Cells(Target.Row, 6) = "Some Calculation"               '<~~ Margin$ Changes
        Cells(Target.Row, 7) = "Some Calculation"               '<~~ Price Changes

    ElseIf Not Intersect(Target, Columns(7)) Is Nothing Then    '<~~ When Cost Price Changes
        Cells(Target.Row, 5) = "Some Calculation"               '<~~ Margin% Changes
        Cells(Target.Row, 6) = "Some Calculation"               '<~~ Margin$ Changes
    End If

LetsContinue:
    Application.EnableEvents = True
    Exit Sub
Whoa:
    MsgBox Err.Description
    Resume LetsContinue
End Sub

我假设第 1 行受到保护，并且用户不会更改它。如果标题行不受保护，那么您将使用If 语句检查行号以排除第 1 行

跟进

我选择其中一个成本（Cost1 中的第一个），按 Ctrl+C，选择 Cost 3 下的所有单元格，然后按 Crl+V，它会复制值，但它只会重新计算第一个单元格的 TotalCost选择。谢谢你的帮助！！！ – Ronald Valdivia 24 分钟前

啊，我明白你在尝试什么 :)

使用此代码

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

    On Error GoTo Whoa

    Application.EnableEvents = False

    If Not Intersect(Target, Columns(1)) Is Nothing Then
        For Each cl In Target
            Cells(cl.Row, 4) = Cells(cl.Row, 1) + Cells(cl.Row, 2) + Cells(cl.Row, 3)
        Next
    ElseIf Not Intersect(Target, Columns(2)) Is Nothing Then
        For Each cl In Target
            Cells(cl.Row, 4) = Cells(cl.Row, 1) + Cells(cl.Row, 2) + Cells(cl.Row, 3)
        Next
    ElseIf Not Intersect(Target, Columns(3)) Is Nothing Then
        For Each cl In Target
            Cells(cl.Row, 4) = Cells(cl.Row, 1) + Cells(cl.Row, 2) + Cells(cl.Row, 3)
        Next
    End If

LetsContinue:
    Application.EnableEvents = True
    Exit Sub
Whoa:
    MsgBox Err.Description
    Resume LetsContinue
End Sub