在另一个工作表中记录"RTD"值更改 [英] Log 'RTD' Value Changes in Another Worksheet

问题描述

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

I'm having some issues finding an answer for this.

在Sheet1中，我有一系列单元格("A4:Q4")，其中所有单元格都具有某些RTD功能，它们在这些单元格中从外部程序收集实时库存数据.这些单元每隔几秒钟更新一次，具体取决于父程序的更改.

In Sheet1, I have a range of cells ("A4:Q4") that all have certain RTD functions in them, where they are gathering real time stock data from an outside program. These cells update every few seconds, depending on the changes from the parent program.

我想要做的是拥有它，以便每次该范围内的任何值更改时(即，每次RTD值更新时)，都复制该范围的值并将其粘贴到Sheet2中的下一个可用空行中.这应该可以有效地创建一长串值，但是我在使用RTD时遇到了问题.我当前的代码将执行我想要的操作，但前提是手动更改范围内的值，而不是更新RTD值时.即使在更新/更改RTD值时，也没有将这些新值复制到Sheet2中.似乎与宏有关，但没有意识到值会自动更改.当我自己更改该范围内的值时，它可以工作，但是这会使单元格中的RTD函数失效.

What I want to do, is have it so that every time any value in that range changes (ie. everytime the RTD values update), copy that range's values and paste them to the next available empty row in Sheet2. This should effectively create a long list of values, but I'm having an issue with the RTD stuff. My current code will do what I want, but only if the values in the range are changed manually, NOT when the RTD values get updated. Even when the RTD values are updating/changing, it's not copying those new values over to Sheet2, if that makes sense. It would seem it has something to do with the macro not realizing that the values are changing automatically. When I make my own changes to the values in that range, it works, but that renders the RTD functions in the cells useless.

这就是我所拥有的:

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

I'm thinking a potential solution would be to make a loop where by it stores each value in that range, and then every half a second or 1 second it would compare the stored values to the "current" values and see if there's any change. If there is, copy that range's values to Sheet2. But this seems clunky.

有什么想法吗?谢谢！

推荐答案

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

As noted in the comments, the Worksheet.Change event doesn't fire when a cell changes value due to formula recalculation. So you can use the Worksheet.Calculate event.

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

Unlike the Worksheet.Change event, there is no Target in the Worksheet.Calculate event. You can test that a cell within your specific range has recalculated using the following:

1. 在 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

在常规代码模块中:

In a normal code module:

Public keyValues()

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

---

(1): keyValues 是一个 Public 数组，当工作簿首次打开时，该数组将填充 keyCells 中的值.

---

(1): keyValues is a Public array that is populated with the values in keyCells when the workbook first opens.

(2):当由于 Sheet1 中的公式重新计算而导致任何单元格发生变化时，会将 keyCells 中的值与 keyCells 中的相应元素进行一次比较> keyValues .如果存在差异，即 keyCells 中的单元格已更新，则将 A4:R4 中的最新值写入 Sheet2 . Exit For 确保即使多个单元格已更改，此值传输也仅发生一次.最后，将 keyValues 更新为 keyCells 中的最新值.

(2): When any cell changes due to formula recalculation in Sheet1, the values in keyCells are compared one-by-one to their corresponding element in keyValues. If there is a difference, i.e. a cell in keyCells has been updated, then the latest values in A4:R4 are written to the next available row in Sheet2. The Exit For ensures that this value transfer only happens once, even if multiple cells have changed. Finally, keyValues is updated with the latest values in keyCells.

(3): PopulateKeyValueArray 从 Sheet1:Range("A4:Q4")的值读取到 keyValues 数组中.

(3): PopulateKeyValueArray reads the values from Sheet1:Range("A4:Q4") into the keyValues array.

请注意，当您第一次将代码添加到工作簿时， keyValues 将为空，因此请保存并重新打开，或者运行 PopulateKeyValueArray 来填充数组.

Note that keyValues will be empty when you first add the code to your workbook, so either save and re-open, or run PopulateKeyValueArray to populate the array.

这篇关于在另一个工作表中记录"RTD"值更改的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！