VBA Excel - Изменение данных на клетки через VBA код

Question

я написал некоторый VBA код к следующему:

1. Давайте предположим, что у меня есть таблица с этими столбцами

[Cost1] [ Cost2] [Cost3] [TotalCost] [Margin%] [Margin $] [Цена]

1. Если пользователь изменяет затраты, общие изменения стоимости и маржи $ и цена, поскольку они зависят от стоимости и Маржа%
2. Если пользователь изменяет цену, стоимость не изменяется, а Margin% и Margin $ изменяются, потому что они зависят от новой цены.

Мне не удалось добавить защищенные формулы в колонку 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

Попробуйте

Я намеренно с разбивкой код на несколько Если заявления и дублировать коды для понимания перспективы. Например,

 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

Followup

я выбираю один из затрат (первый из Cost1), сделайте Ctrl + C, выберите все ячейки по цене 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