Question

当我手动更新第一列时，下面的代码工作正常。我需要知道当我通过公式更新列时，是否还有一种方法可以使这段代码工作。

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

Answer 1

Worksheet_Change在响应公式更新时不会触发。

请参阅Worksheet_Change

的Excel帮助

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

您可以通过Worksheet_Calculate事件实现您想要的目标。

假设您希望在这些vall值更改时在单元格旁边添加时间戳，请尝试此操作（除了Change事件）。

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

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

如何通过公式更改单元格内容时运行VBA代码

1 个答案: