3

行の任意のセルで値（常に数値形式）が変更されたときに、（セルの背景色を赤に変更して）通知するマクロのヘルプが必要です。セルF3：AN3の値のいずれかが現在の値から変更された場合、セルE3の背景を赤に変更したいと思います。

セルF3：AN3の数値は、手動で入力するか、行をコピーして貼り付けることで入力します。数式はありません。同様に、セルF4：AN4の値が変更された場合、グラフの各行のセルE4を赤い背景に変更します。すべての行に常に値があるわけではないので、「」から任意の＃へ、またはある＃から別の＃へ、または任意の＃から「」への変更を探します。理想的には、これは手動で実行する必要のないイベントマクロです。

以下は私が使い始めたコードです：

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Range("F3:AN3")) Is Nothing Then KeyCellsChanged
End Sub


Private Sub KeyCellsChanged()

   Dim Cell As Object
     For Each Cell In Range("E3")
    Cell.Interior.ColorIndex = 3

   Next Cell

End Sub

ただし、このマクロは、セル内の数値が変更されているかどうかに関係なく実行されているように見えます。Enterキーを押す限り、E3が赤で強調表示されます。

どんな助けでも大歓迎です！

4

2 に答える 2

3

Excel VBA アプリの変更を検出する私のお気に入りの方法は次のとおりです。

  1. ユーザーに表示される範囲の下の非表示の行に、監視している範囲の正確なコピーを作成します。
  2. その下 (これも非表示) に別のセクションを追加し、ユーザー範囲と非表示範囲を減算する数式を使用して、差が 0 以外の場合に値を 1 に設定する if ステートメントを使用します。
  3. 対応する変更検出行 (またはセル) が > 0 の場合に行の背景色を変更する条件付き書式をユーザー範囲で使用します。

このアプローチの気に入っているところ：

  1. ユーザーが変更を行ってから元の値に戻した場合、その行は何も変更されていないことを認識できるほど「スマート」です。
  2. ユーザーが何かを変更するたびに実行されるコードは面倒であり、問​​題を引き起こす可能性があります。私が説明している方法で変更検出を設定すると、コードはシートが初期化されたときにのみ起動します。worksheet_change イベントは負荷が高く、「Excel の元に戻す機能を事実上オフにする可能性があります。イベント プロシージャがワークシートに変更を加えるたびに、Excel の元に戻すスタックが破棄されます。」(John Walkenbach: Excel 2010 Power Programmingによる)
  3. ユーザーがページから移動しようとしているかどうかを検出し、変更内容が失われることを警告できます。
于 2012-05-04T02:03:53.590 に答える
3

コメントでの私の質問に対するあなたの回答に応じて、このコードは変更される可能性があります。これを関連するワークシート コード領域に貼り付けます。これを機能させるには、他のシートに移動してから、元のシートに戻ります。

Option Explicit

Dim PrevVal As Variant

Private Sub Worksheet_Activate()
    If Selection.Rows.Count = 1 And Selection.Columns.Count = 1 Then
        PrevVal = Selection.Value
    Else
        PrevVal = Selection
    End If
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    On Error GoTo ExitGraceFully
    If Selection.Rows.Count = 1 And Selection.Columns.Count = 1 Then
        PrevVal = Selection.Value
    Else
        PrevVal = Selection
    End If
ExitGraceFully:
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
    If Application.WorksheetFunction.CountA(Target) = 0 Then Exit Sub

    Dim aCell As Range, i As Long, j As Long

    On Error GoTo Whoa

    Application.EnableEvents = False

    If Not Intersect(Target, Columns("F:AN")) Is Nothing Then
        If Target.Rows.Count = 1 And Target.Columns.Count >= 1 Then
            Range("E" & Target.Row).Interior.ColorIndex = 3
        ElseIf Target.Rows.Count > 1 And Target.Columns.Count = 1 Then
            i = 1
            For Each aCell In Target
                If aCell.Value <> PrevVal(i, 1) Then
                    Range("E" & aCell.Row).Interior.ColorIndex = 3
                End If
                i = i + 1
            Next
        ElseIf Target.Rows.Count > 1 And Target.Columns.Count > 1 Then
            Dim pRow As Long

            i = 1: j = 1

            pRow = Target.Cells(1, 1).Row

            For Each aCell In Target
                If aCell.Row <> pRow Then
                    i = i + 1: pRow = aCell.Row
                    j = 1
                End If

                If aCell.Value <> PrevVal(i, j) Then
                    Range("E" & aCell.Row).Interior.ColorIndex = 3
                End If
                j = j + 1
            Next
        End If
    End If

LetsContinue:
    Application.EnableEvents = True
    Exit Sub
Whoa:
    Resume LetsContinue
End Sub

スナップショット

セルに値を入力すると、期待どおりに機能します。1 つのセルをコピーして複数のセルに貼り付ける場合にも機能します。セルのブロックをコピーして貼り付けると機能しません（私はまだこれに取り組んでいます）

ここに画像の説明を入力

注: これは広範囲にテストされていません。

于 2012-05-04T08:36:49.073 に答える