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。

假设您想在这些 val 值更改时在单元格旁边放置一个时间戳，请尝试此操作（除了您的Change事件）。

请注意使用Static变量来跟踪以前的值，因为Calculateevent 不提供Target像这样的参数Change。这种方法可能不够健壮，因为Static如果您中断 vba 执行（例如，在未处理的错误上）， ' 将被重置。如果您希望它更健壮，请考虑将以前的值保存在另一个（隐藏的）工作表上。

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 回答