选中或取消选中复选框时放置时间戳记

Question

我有一个包含3行7列的工作表（A1:G3）。
A和B列有6个复选框（A1:B3）。A和B列中的框分别链接到C和D列。E和F列中的E1单元格分别只是复制C和D列（活动单元格为=C1和F3单元格为=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，时间戳把所有的得到G1，G2而G3细胞，即使我刚刚打勾的框之一。

Answer 1

您似乎将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