1

私はいくつかのVBAコードを次のように書きました:

  1. この列を含むスプレッドシートがあるとしましょう

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

  1. ユーザーがコストを変更すると、コストと Margin% に依存するため、合計コストと Margin$ と Price が変更されます。
  2. ユーザーが Price を変更した場合、コストは変更されませんが、Margin% と Margin$ は変更されます。これは、新しい価格に依存するためです。

ユーザーがその値を変更する可能性があるため、保護された数式を Price 列に追加できませんでした。したがって、数式は消去されます。そこで、計算に関して完全に機能する VBA をコーディングすることにしました。ただし、Excel の最も重要な機能のいくつかを失いました。たとえば、1 つの価格の値を他のいくつかの行にコピーしたい場合、コピーされた最初の行の再計算をトリガーするだけで、他の行の再計算はトリガーしません。セルを出た後、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。を使用する場合、これら 2 つは必須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 を除外します。

ファローアップ

コストの 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 に答える