VBA Excel中通过VBA代码

Question

我已经写了一些VBA代码以下修改对细胞的数据：

1. 比方说，我有此列的表格

[COST1] [ Cost2] [COST3] [TOTALCOST] [页边距％] [保证金$] [参考价格]

1. 如果用户因为它们依赖于成本和修改成本，总成本变化和保证金$和价格保证金％
2. 如果用户修改价格，成本不会改变，但保证金％和保证金$确实会发生变化，因为它们取决于新的价格。

我无法将受保护的公式添加到Price列，因为用户可能想要更改该值，因此公式将被删除。所以我决定编写完美的计算方式的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一起工作时，这两个是MUST。 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行是受保护的用户是不会改变这一点。如果标题行是不受保护的，那么你将有检查的行号withing的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