excel - 在另一个工作表中记录 'RTD' 值更改

Question

我在寻找答案时遇到了一些问题。

在 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。但这似乎很笨拙。

有任何想法吗？谢谢!

Answer 1

如评论中所述，当单元格由于公式重新计算而更改值时，不会触发 Worksheet.Change 事件。因此，您可以使用 Worksheet.Calculate 事件。

与 Worksheet.Change 事件不同，没有 Target在 Worksheet.Calculate 事件中。您可以使用以下方法测试特定范围内的单元格是否已重新计算:

在 ThisWorkbook代码模块:

Private Sub Workbook_Open()
    PopulateKeyValueArray
End Sub

在 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

在普通代码模块中:

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填充数组。