2010-12-08 9 views
5

セルの取得が式によって変更されるたびにVBAコードを実行する方法を知りたいですか?私はセルがその値をユーザーによって変更されるとコードを実行することができましたが、動作しません。セルのgetが式によって値が変更されるたびに、どのようにVBAコードを実行できますか?

+0

特定のセル、またはすべてのセル?手動での変更だけに対応したいのですか、または再計算によって引き起こされた変更にも対応しますか? –

+0

リプレイをありがとう!さて、その特定の列、と私はちょうどrecalcによって引き起こされたイベントをつかむために。ここで私は何をしようとしているのですか?B列には数式があり、A1 = 2と言うことができます。 – Cloaky

答えて

11

セルA1(たとえば= B1 * C1)の式があり、いずれかのセルB1やC1への更新のために、コード毎時間A1の変化は、私が使用することができます以下

Private Sub Worksheet_Calculate() 
    Dim target As Range 
    Set target = Range("A1") 

    If Not Intersect(target, Range("A1")) Is Nothing Then 
    //Run my VBA code 
    End If 
End Sub 

アップデートを

は、私の知る限りでは Worksheet_Calculateに問題があることである

式を含むすべてのセルで発生するスプレッドシートにはどのセルが再計算されたかを特定できません(つまり、 Worksheet_CalculateTargetオブジェクトを提供しません)

これを回避するには、列Aに多数の数式があり、どのセルが更新されているかを特定して特定のセルにコメントを追加する場合は、次のコード

説明するには、式を更新するには、その式の入力セルの1つを変更する必要があります。 A1の式が=B1 * C1の場合、B1またはのいずれかをA1に変更する必要があります。

Worksheet_Changeイベントを使用して、s /シートのセル変更を検出し、Excelの監査機能を使用して依存関係をトレースすることができます。セルA1はB1C1の両方に依存し、この場合、コードTarget.Dependents.Addressは、B1またはC1に変更すると$A$1を返します。

これを考えると、従属アドレスが列Aにあるかどうかを確認するだけです(Intersectを使用)。列Aにある場合は、適切なセルにコメントを追加できます。

これは、セルに一度だけコメントを追加する場合にのみ有効です。同じセル内のコメントを上書きし続けたい場合は、コメントの存在を最初に確認し、必要に応じて削除するコードを変更する必要があります。

+0

それはうまくいった!もう1つだけ必要ですが、範囲が列範囲( "A:A")であると言うと、どの行/セルがその値を変更したのか知りたいのですが、どうすればいいですか?もう一度ありがとう。 AddComment Text:= "aaaaaaa" – Cloaky

+0

@Cloaky - わかりやすく、Worksheet_Calculateイベントは、ワークシートの式を含むすべてのセルに対して実行されます。したがって、複数の数式を含む列でどのセルが更新されたのかを簡単に把握することはできません。私はこれをハックすると思うかもしれませんが、シートの構造や入力があなたの公式のどこにあるかによって決まります... –

+0

@ Cloaky - 私はypour問題の解決策を得ていると思います...更新された投稿を見てください... –

1

ここに、クラスを使用する別の方法があります。クラスはセルの初期値とセルアドレスを格納できます。計算イベントでは、アドレスの現在の値と格納されている初期値を比較します。以下の例では、1つのセルのみ(「A2」)を聴くようにしていますが、モジュール内でより多くのセルを聴取したり、クラスを変更してより広い範囲で動作させることができます。 "クラス1" と呼ばれる

クラスモジュール:

Public WithEvents MySheet As Worksheet 
Public MyRange As Range 
Public MyIniVal As Variant 

Public Sub Initialize_MySheet(Sh As Worksheet, Ran As Range) 
    Set MySheet = Sh 
    Set MyRange = Ran 
    MyIniVal = Ran.Value 
End Sub 
Private Sub MySheet_Calculate() 

If MyRange.Value <> MyIniVal Then 
    Debug.Print MyRange.Address & " was changed from " & MyIniVal & " to " & MyRange.Value 
    StartClass 
End If 

End Sub 

normallモジュールでクラスを初期化します。ここで

Dim MyClass As Class1 

Sub StartClass() 
Set MyClass = Nothing 
Set MyClass = New Class1 
MyClass.Initialize_MySheet ActiveSheet, Range("A2") 
End Sub 
0

は私のコードです:

私はそれはひどい見えます知っているが、それは動作します! もちろん、はるかに優れたソリューションがあります。コードの

説明:ブックが開くと、N15までのセルB15の値をPrevValnまで可変PrevValbに

保存されています。 Worksheet_Calculate()イベントが発生すると、以前の値がセルの実際の値と比較されます。値が変更された場合、セルは赤色でマークされます。このコードは、関数を使って書くことができるので、読む時間がずっと短くて簡単です。 カラーリセットボタン(Seenchanges)があります。これにより、色が前の色にリセットされます。

ワークブック:

Private Sub Workbook_Open() 
PrevValb = Tabelle1.Range("B15").Value 
PrevValc = Tabelle1.Range("C15").Value 
PrevVald = Tabelle1.Range("D15").Value 
PrevVale = Tabelle1.Range("E15").Value 
PrevValf = Tabelle1.Range("F15").Value 
PrevValg = Tabelle1.Range("G15").Value 
PrevValh = Tabelle1.Range("H15").Value 
PrevVali = Tabelle1.Range("I15").Value 
PrevValj = Tabelle1.Range("J15").Value 
PrevValk = Tabelle1.Range("K15").Value 
PrevVall = Tabelle1.Range("L15").Value 
PrevValm = Tabelle1.Range("M15").Value 
PrevValn = Tabelle1.Range("N15").Value 
End Sub 

MODUL:

Sub Seenchanges_Klicken() 
Range("B15:N15").Interior.Color = RGB(252, 213, 180) 
End Sub 

シート1:

Private Sub Worksheet_Calculate() 
If Range("B15").Value <> PrevValb Then 
    Range("B15").Interior.Color = RGB(255, 0, 0) 
    PrevValb = Range("B15").Value 
End If 
If Range("C15").Value <> PrevValc Then 
    Range("C15").Interior.Color = RGB(255, 0, 0) 
    PrevValc = Range("C15").Value 
End If 
If Range("D15").Value <> PrevVald Then 
    Range("D15").Interior.Color = RGB(255, 0, 0) 
    PrevVald = Range("D15").Value 
End If 
If Range("E15").Value <> PrevVale Then 
    Range("E15").Interior.Color = RGB(255, 0, 0) 
    PrevVale = Range("E15").Value 
End If 
If Range("F15").Value <> PrevValf Then 
    Range("F15").Interior.Color = RGB(255, 0, 0) 
    PrevValf = Range("F15").Value 
End If 
If Range("G15").Value <> PrevValg Then 
    Range("G15").Interior.Color = RGB(255, 0, 0) 
    PrevValg = Range("G15").Value 
End If 
If Range("H15").Value <> PrevValh Then 
    Range("H15").Interior.Color = RGB(255, 0, 0) 
    PrevValh = Range("H15").Value 
End If 
If Range("I15").Value <> PrevVali Then 
    Range("I15").Interior.Color = RGB(255, 0, 0) 
    PrevVali = Range("I15").Value 
End If 
If Range("J15").Value <> PrevValj Then 
    Range("J15").Interior.Color = RGB(255, 0, 0) 
    PrevValj = Range("J15").Value 
End If 
If Range("K15").Value <> PrevValk Then 
    Range("K15").Interior.Color = RGB(255, 0, 0) 
    PrevValk = Range("K15").Value 
End If 
If Range("L15").Value <> PrevVall Then 
    Range("L15").Interior.Color = RGB(255, 0, 0) 
    PrevVall = Range("L15").Value 
End If 
If Range("M15").Value <> PrevValm Then 
    Range("M15").Interior.Color = RGB(255, 0, 0) 
    PrevValm = Range("M15").Value 
End If 
If Range("N15").Value <> PrevValn Then 
    Range("N15").Interior.Color = RGB(255, 0, 0) 
    PrevValn = Range("N15").Value 
End If 
End Sub 
2

あなたが使用したコードの細胞変化は式電池ではありませんので動作しませんが、売る...変更されている:)

あなたがワークシートのモジュールに追加したものを次に示します。

(Udated:行rdependents = Target.Dependentsは、扶養家族がいない場合、エラーを発生させます。このアップデートでは、このの世話をする。)当該セルアドレスの配列をSETINGすることにより、多くの依存性細胞がある場合は、これを拡張することができ

Private Sub Worksheet_Change(ByVal Target As Range) 
    Dim rDependents As Range 

    On Error Resume Next 
    Set rDependents = Target.Dependents 
    If Err.Number > 0 Then 
     Exit Sub 
    End If 
    ' If the cell with the formula is "F160", for example... 
    If Not Application.Intersect(rDependents, Range("F160")) Is Nothing Then 
     Call abc 
    End If 
End Sub 

Private Sub abc() 
    MsgBox """abc()"" is running now" 
End Sub 

。次に、配列内の各アドレスをテストし(ループ構造を使用できます)、変更されたセルに対応するサブルーチンを実行します(SELECT CASE ...を使用)。

+3

ようこそStackOverflow ...あなたは答えを与える4歳の質問は、すでに受け入れられた答えを知っていましたか?最近の質問や、受け入れられていない質問に回答することで担当者を育てることをお勧めします(回答が改善されると感じる場合を除いて、答えを参照する必要がある場合を除いて)。 – Chrismas007

+1

コメントありがとうございました。はい、私はそれが古いQであることを認識しますが、人々は答えを探し続けると、ここでは "受け入れられた答え"は私の意見では良いenouphではありません。 –

関連する問題