选中或取消选中复选框时放置时间戳记 [英] Put timestamp when a checkbox is ticked or unticked

问题描述

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

I have a worksheet with 3 rows and 7 columns (A1:G3).
A and B columns have 6 checkboxes (A1:B3). Boxes in columns A & B are linked to columns C & D respectively. Cells in columns E & F are just replicating columns C & D respectively (live E1 cell is =C1 and F3 cell is =D3).

我想通过在VBA中使用该工作表的Worksheet_Calculate事件来选中或取消选中复选框，在每行的单元格G中放置一个时间戳.

I want to put a timestamp in cell G for each row when a checkbox is ticked or unticked by using Worksheet_Calculate event in VBA for that sheet.

我的代码仅用于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行.

I want to combine the code for 3 rows.

这里有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 结合使用时，无论我是否勾选 B1 ，时间戳都只放入 G1 或 C2 .

When I combine them with ElseIf like in the code above, a timestamp gets put in only G1, no matter if I tick B1 or 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 单元格，即使我仅勾选其中一个框.

When I combine them by ending each one with End If and start a new If, timestamp gets put in all of the G1, G2 and G3 cells, even if I tick just one of the boxes.

推荐答案

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

You seem to be confusing Worksheet_Calculate with Worksheet_Change and using Intersect as if one of the arguments was Target (which Worksheet_Calculate does not have).

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

Intersect(cbX1, Range("A1:F1")) is always not nothing because you are comparing six apples to the same six apples. You might as well ask 'Is 1,2,3,4,5,6 the same as 1,2,3,4,5,6?'.

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

You need a method of recording the values of your range of formulas from one calculation cycle to the next. Some use a public variable declared outside the Worksheet_calculate sub procedure; personally I prefer a Static variant array declared within the Worksheet_calculate sub.

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

The problem with these is initial values but this can be accomplished since workbooks undergo a calculation cycle when opened. However, it is not going to register Now in column G the first time you run through a calculation cycle; you already have the workbook open when you paste in the code and it needs one calculation cycle to 'seed' the array containing the previous calculation cycle's values.

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

这篇关于选中或取消选中复选框时放置时间戳记的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！