VBA Excel - 通过VBA代码修改单元格上的数据-Java 学习之路

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

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

[Cost1] [Cost2] [Cost3] [TotalCost] [保证金％] [保证金$] [价格]

如果用户修改了成本，总成本会发生变化，保证金和价格会因为它们取决于成本和保证金百分比而变化
如果用户修改了价格，则成本不会改变，但保证金百分比和保证金$确实会发生变化，因为它们取决于新价格 .

我无法将受保护的公式添加到Price列，因为用户可能想要更改该值，因此公式将被删除 . 所以我决定编写VBA，它可以完美地计算 . 但是，我已经失去了一些excel最有 Value 的功能：例如如果想要将一个价格的值复制到其他几个行，它只会触发重新计算第一行的位置，而不是其他行 . 退出牢房后，我也失去了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

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 并最终正常退出代码来阻止代码中断 .

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

我假设第1行受到保护，用户不会改变它 . 如果Header行未受保护，那么您将检查带有 If 语句的行号以排除第1行

FOLLOWUP

我选择其中一个成本（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

回复于 2024-05-03T15:29:45+08:00

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

1 回答

相关问题