公式更改时放入时间戳记

时间:2018-12-12 06:36:06

标签: excel vba excel-vba

这很重要:我有一个包含3行7列(A1:G3)的工作表。 A和B列具有6个复选框(A1:B3)。 A和B列中的框分别链接到C和D列。 E和F列中的单元格分别只是复制C和D列(活动E1单元格为=C1F3单元格为=D3)。

我想通过在VBA中使用该工作表的Worksheet_Calculate事件来选中或取消选中复选框,在每行的G单元格中放置时间戳。当我仅使用1行时,就可以使我的代码正常工作。这是代码:

   Private Sub Worksheet_calculate()
        Dim cbX1 As Range
        Set cbX1 = Range("A1:F1")
        If Not Intersect(cbX1, Range("A1:F1")) Is Nothing Then
            Range("G1").Value = Now()
        End If
   End Sub

问题是,当我想将代码合并为3行时,它不起作用。 这里有2种变化: 第一个:

Private Sub Worksheet_calculate()
    Dim cbX1 As Range
    Dim cbX2 As Range
    Dim cbX3 As Range
    Set cbX1 = Range("A1:F1")
    Set cbX2 = Range("A2:F2")
    Set cbX3 = Range("A3:F2")
    If Not Intersect(cbX1, Range("A1:F1")) Is Nothing Then
        Range("G1").Value = Now()
    ElseIf Intersect(cbX2, Range("A2:F2")) Is Nothing Then
        Range("G2").Value = Now()
    ElseIf Intersect(cbX3, Range("A3:F3")) Is Nothing Then
        Range("G3").Value = Now()
    End If
End Sub 

当像上面的代码一样将它们与ElseIf结合使用时,无论我打勾G1还是B1,时间戳都只会放入C2

第二个:

Private Sub Worksheet_calculate()
    Dim cbX1 As Range
    Dim cbX2 As Range
    Dim cbX3 As Range
    Set cbX1 = Range("A1:F1")
    If Not Intersect(cbX1, Range("A1:F1")) Is Nothing Then
        Range("G1").Value = Now()
    End If
    Set cbX2 = Range("A2:F2")
    If Not Intersect(cbX2, Range("A2:F2")) Is Nothing Then
        Range("G2").Value = Now()
    End If
    Set cbX3 = Range("A3:F2")
    If Not Intersect(cbX3, Range("A3:F3")) Is Nothing Then
        Range("G3").Value = Now()
    End If
End Sub

当我将它们分别用End If结尾并开始一个新的If组合起来时,时间戳记会放入所有G1G2和{{1} }单元格,即使我只勾选其中一个框。

我知道我写的有点复杂,但是我想尽我所能。我希望任何人都可以帮助我将多行代码组合在一起。

1 个答案:

答案 0 :(得分:4)

您似乎将Worksheet_Calculate与Worksheet_Change混淆,并使用Intersect,就好像其中一个参数是Target(Worksheet_Calculate没有该参数)一样。

Intersect(cbX1, Range("A1:F1"))总是 ,因为您将六个苹果与相同的六个苹果进行比较。您可能会问'1,2,3,4,5,6与1,2,3,4,5,6是否相同?'

您需要一种方法来记录从一个计算周期到下一个计算周期的一系列公式的值。有些使用在Worksheet_calculate子过程外部声明的公共变量;我个人更喜欢在Worksheet_calculate子对象中声明的静态变量数组。

这些问题是初始值,但这可以实现,因为工作簿在打开时会经历一个计算周期。但是,第一次运行计算周期时,它不会立即在G列中注册。粘贴代码后,您已经打开了工作簿,并且它需要一个计算周期才能“种子”包含先前计算周期值的数组。

Option Explicit

Private Sub Worksheet_Calculate()
    Static vals As Variant

    If IsEmpty(vals) Then   'could also be IsArray(vals)
        vals = Range(Cells(1, "A"), Cells(3, "F")).Value2
    Else
        Dim i As Long, j As Long
        With Range(Cells(1, "A"), Cells(3, "F"))
            For i = LBound(vals, 1) To UBound(vals, 1)
                For j = LBound(vals, 2) To UBound(vals, 2)
                    If .Cells(i, j).Value2 <> vals(i, j) Then
                        Application.EnableEvents = False
                        .Cells(i, "G") = Now
                        Application.EnableEvents = True
                        vals(i, j) = .Cells(i, j).Value2
                    End If
                Next j
            Next i
        End With
    End If

End Sub