Поставьте метку времени при изменении формулы

Question

Вот предложение: у меня есть лист с 3 строками и 7 столбцами (A1:G3).Столбцы A и B имеют 6 флажков (A1:B3).Поля в столбцах A и B связаны с столбцами C и D соответственно.Ячейки в столбцах E & F являются просто реплицирующими столбцами C & D соответственно (действительная E1 ячейка =C1 и F3 ячейка =D3).

Я хочу поставить отметку времени, когда в ячейке Gдля каждой строки всякий раз, когда флажок отмечен или снят с помощью события Worksheet_Calculate в VBA для этого листа.Я могу заставить мой код работать, когда я использую только для 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 варианта: 1-й:

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.

2-й:

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