1

我已经为以下内容编写了一些 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
4

1 回答 1

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 选择。谢谢你的帮助！！！– 罗纳德·瓦尔迪维亚 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
于 2012-04-18T14:05:12.287 回答