Записать изменения значений «RTD» в другой таблице

Question

У меня возникли проблемы с поиском ответа на этот вопрос.

В Листе 1 у меня есть ряд ячеек («A4: Q4»), в которых все имеют определенные функции RTD, где они собирают данные о запасах в реальном времени из внешней программы. Эти ячейки обновляются каждые несколько секунд, в зависимости от изменений в родительской программе.

Я хочу сделать так, чтобы каждый раз, когда любое значение в этом диапазоне изменялось (т. Е. Каждый раз, когда обновлялись значения RTD), копировало значения этого диапазона и вставляло их в следующую доступную пустую строку в Sheet2. Это должно эффективно создать длинный список значений, но у меня возникла проблема с RTD. Мой текущий код будет делать то, что я хочу, но только если значения в диапазоне изменяются вручную, а НЕ когда обновляются значения RTD. Даже когда значения RTD обновляются / изменяются, новые значения не копируются в Sheet2, если это имеет смысл. Казалось бы, это как-то связано с макросом, который не понимает, что значения меняются автоматически. Когда я делаю свои собственные изменения в значениях в этом диапазоне, это работает, но это делает функции RTD в ячейках бесполезными.

Вот что у меня есть:

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim KeyCells As Range

    ' The variable KeyCells contains the cells that will
    ' cause an alert when they are changed.
    Set KeyCells = Worksheets("Sheet1").Range("A4:Q4")

    ' Wait for change to happen...
    If Not Application.Intersect(KeyCells, Range(Target.Address)) _
           Is Nothing Then


    ' once change happens, copy the range (yes keep R4 value too)
    ThisWorkbook.Worksheets("Sheet1").Range("A4:R4").Copy

    ' Paste it into the next empty row of Sheet2
    With ThisWorkbook.Worksheets("Sheet2")
        Dim NextRow As Range
        Set NextRow = ThisWorkbook.Worksheets("Sheet2").Range("A" & .UsedRange.Rows.Count + 1)
        NextRow.PasteSpecial Paste:=xlValues, Transpose:=False

        Application.CutCopyMode = False

    End With

End If
End Sub

Я думаю, что потенциальным решением было бы сделать цикл, в котором он будет хранить каждое значение в этом диапазоне, а затем каждые полсекунды или 1 секунду он будет сравнивать сохраненные значения с «текущими» значениями и видеть, есть какие-то изменения. Если есть, скопируйте значения этого диапазона в Sheet2. Но это кажется неуклюжим.

Есть идеи? Спасибо!

Answer 1

Как отмечено в комментариях, событие Worksheet.Change не срабатывает, когда ячейка меняет значение из-за пересчета формулы. Таким образом, вы можете использовать событие Worksheet.Calculate.

В отличие от события Worksheet.Change, в событии Worksheet.Calculate нет Target. Вы можете проверить, что ячейка в пределах вашего определенного диапазона пересчитана, используя следующее:

---

1. В модуле кода ThisWorkbook:

   Private Sub Workbook_Open()
       PopulateKeyValueArray
   End Sub
   

2. В модуле кода Sheet1:

   Private Sub Worksheet_Calculate()
   
       On Error GoTo SafeExit
       Application.EnableEvents = False
   
       Dim keyCells As Range
       Set keyCells = Me.Range("A4:Q4")
   
       Dim i As Long
       For i = 1 To UBound(KeyValues, 2)
           If keyCells(, i).Value <> keyValues(1, i) Then
   
               Dim lastRow As Long
               With Sheet2
                   lastRow = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
                   .Range("A" & lastRow & ":R" & lastRow).Value =   Me.Range("A4:R4").Value
               End With
   
               Exit For
           End If
       Next i
   
   SafeExit:
       PopulateKeyValueArray
       Application.EnableEvents = True
   End Sub
   

3. В обычном кодовом модуле:

   Public keyValues()
   
   Public Sub PopulateKeyValueArray()
       keyValues = Sheet1.Range("A4:Q4").Value
   End Sub
   

---

(1): keyValues - это массив Public, который заполняется значениями в keyCells при первом открытии книги.

(2): Когда любая ячейка изменяется из-за пересчета формулы в Sheet1, значения в keyCells сравниваются один за другим с их соответствующим элементом в keyValues. Если есть разница, то есть ячейка в keyCells была обновлена, то самые последние значения в A4:R4 записываются в следующую доступную строку в Sheet2. Exit For гарантирует, что эта передача значения происходит только один раз, даже если изменилось несколько ячеек. Наконец, keyValues обновляется с последними значениями в keyCells.

(3): PopulateKeyValueArray считывает значения из Sheet1:Range("A4:Q4") в массив keyValues.

Обратите внимание, что keyValues будет пустым при первом добавлении кода в рабочую книгу, поэтому либо сохраните и снова откройте, либо запустите PopulateKeyValueArray для заполнения массива.