在另一个工作表中记录“RTD”值更改

Posted 2023-01-19

我有一些问题找到答案。

在Sheet1中，我有一系列单元格（“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。但这似乎很笨拙。

有任何想法吗？谢谢！

答案

如注释中所述，当单元格由于公式重新计算而更改值时，不会触发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来填充数组。