0

以下のコードは、列 I を手動で更新すると正常に動作します。数式で列を更新したときに、このコードを引き続き機能させる方法があるかどうかを知る必要があります。

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
    With Target
        If .Count > 1 Then Exit Sub

        If Not Intersect(Range("I3:I30"), .Cells) Is Nothing Then
            Application.EnableEvents = False
            If IsEmpty(.Value) Then
                .Offset(0, -1).ClearContents
            Else
                With .Offset(0, -1)
                    .NumberFormat = "m/d/yy h:mm"
                    .Value = Now
                End With
            End If

            Application.EnableEvents = True
        End If
    End With
End Sub
4

1 に答える 1

1

Worksheet_Change式の更新に応答して起動しません。

については、Excel のヘルプを参照してください。Worksheet_Change

Occurs when cells on the worksheet are changed by the user or by an external link.

Worksheet_Calculateイベントであなたが望むものを達成できるかもしれません。

これらの vall 値が変更されたときにセルの横にタイムスタンプを付けたいと仮定すると、これを試してください (Changeイベントに加えて)。

イベントはパラメータを提供しないためStatic、前の値を追跡するために変数を使用することに注意してください。このメソッドは、vba の実行を中断すると (未処理のエラーなどで) がリセットされるため、十分に堅牢ではない可能性があります。より堅牢にしたい場合は、以前の値を別の (非表示の) シートに保存することを検討してください。CalculateTargetChangeStatic

Private Sub Worksheet_Calculate()
    Dim rng As Range, cl As Range
    Static OldData As Variant

    Application.EnableEvents = False
    Set rng = Me.Range("I3:I30")

    If IsEmpty(OldData) Then
        OldData = rng.Value
    End If

    For Each cl In rng.Cells
        If Len(cl) = 0 Then
            cl.Offset(0, -1).ClearContents
        Else
            If cl.Value <> OldData(cl.Row - rng.Row + 1, 1) Then
                With cl.Offset(0, -1)
                    .NumberFormat = "m/d/yy h:mm:ss"
                    .Value = Now
                End With
            End If
        End If
    Next
    OldData = rng.Value
    Application.EnableEvents = True
End Sub

アップデート

サンプル シートでテスト済みのルーチン、すべて期待どおりに動作

サンプル ファイルには、25 枚のシートで繰り返される同じコードが含まれており、タイム スタンプまでの範囲は 10000 行の長さです。

コードを繰り返さないようにするには、Workbook_イベントを使用します。実行時間を最小限に抑えるには、ループにバリアント配列を使用します。

Private Sub Workbook_SheetCalculate(ByVal Sh As Object)
    Dim rng As Range
    Dim NewData As Variant

    Dim i As Long
    Static OldData As Variant

    Application.EnableEvents = False
    Set rng = Sh.Range("B2:C10000")  ' <-- notice range includes date column
    NewData = rng

    If IsEmpty(OldData) Then
        OldData = rng.Value
    End If

    For i = LBound(NewData, 1) To UBound(NewData, 1)
        If Len(NewData(i, 1)) = 0 And Len(NewData(i, 2)) > 0 Then
             rng.Cells(i, 2).ClearContents
        Else
            If NewData(i, 1) <> OldData(i, 1) Then
                With rng.Cells(i, 2)
                    .NumberFormat = "m/d/yy -- h:mm:ss"
                    .Value = Now
                End With
            End If
        End If
    Next
    OldData = rng.Value
    Application.EnableEvents = True
End Sub

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    'Activate date population on cell change
    With Target
        If .Count > 1 Then Exit Sub
        If Not Intersect(Sh.Range("B2:B10000"), .Cells) Is Nothing Then
            Application.EnableEvents = False
            If IsEmpty(.Value) Then
                .Offset(0, 1).ClearContents
            Else
                 'Populate date and time in column c
                With .Offset(0, 1)
                    .NumberFormat = "mm/dd/yyyy -- hh:mm:ss"
                    .Value = Now
                End With
            End If
            Application.EnableEvents = True
        End If
    End With

End Sub
于 2013-03-29T02:00:31.533 に答える