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事件不同，Worksheet.Calculate事件中没有Target。您可以使用以下方法测试特定范围内的单元格是否已重新计算：

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

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

1 个答案: