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

VBA Excel - Modify data on cells through VBA code

提问by Ronald Valdivia

I've written some VBA code to the following:

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

1. Let's say that I have an spreadsheet with this columns

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

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

[成本1] [成本2] [成本3] [总成本] [保证金%] [保证金$] [价格]

1. If the user modifies the costs, the total cost changes and the Margin$ and Price because they depend on the cost and the Margin%
2. If the user modifies the Price, the cost don't change but the Margin% and the Margin$ do change, because they depend on the new price.

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

I was not able to add protected formulas to the Price column because the user may want to change that value, thus the formula would be erased. So I decided to code VBA which works perfectly calculation wise. However, I've lost some of the most valued features of excel: e.g. If a want to copy the value of one price to several other rows, it just triggers the recalculation for the firs row where it is copied but not for the others. I'v also lost the ability of UNDO after exiting the cell.

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

To detect that a cell was modified I'm using the following:

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

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

回答by Siddharth Rout

Try this

尝试这个

I have deliberately broken down the code into several If statements and duplicate codes for understanding perspective. For example

为了理解透视，我特意把代码分解成几个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

Please put them in a common procedure.

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

Also note the use of Error Handlingand Application.EnableEvents. These two are a MUSTwhen working with Worksheet_Change. Application.EnableEvents = Falseensures that the code doesn't get into a possibleinfinite loop in case there are recursive actions. Error Handlingnot only handles the error but also stops the code from breaking up by showing you an error message and then resetting the Application.EnableEventsto Trueand finally exiting the code gracefully.

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

Code

代码

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

I am assuming that Row 1 is protected and the user is not gonna change that. If the Header row is unprotected then you will have check for the row number withing the IfStatements to exclude Row 1

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

FOLLOWUP

跟进

I select one of the costs (first of Cost1), do a Ctrl+C, select all cells under Cost 3 and do Crl+V, it copies the values but it only re-calculates the TotalCost for the firs cell of the selection. Than you for your help!!! – Ronald Valdivia 24 mins ago

我选择其中一个成本（Cost1 的第一个），按 Ctrl+C，选择 Cost 3 下的所有单元格并执行 Crl+V，它复制值但它只重新计算选择的第一个单元格的 TotalCost。比你的帮助！– 罗纳德·瓦尔迪维亚 24 分钟前

Ah I see what you are trying :)

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

Use this code

使用此代码

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