在 Excel 工作表中以特定格式记录所有更改

Question

我有一个名为 STOCKS 的 Excel 工作表，它可以自动更新股票行情，例如股票名称、时间、最后交易价格、买入价、卖出价等。

Stock Name | Time | Last Trade Rate | Bid Price | Offer Price
1 ACC      | 10.40am| 42            | 41        | 43
2 INFY     | 10.40am| 100           | 99        | 101
3 TECH     | 10.40am| 140           | 136       | 142

每只股票的价格和其他所有行值每秒都在变化，并且会随着价格变化或出价、出价变化而自动更新。

我添加了一个名为 LOGSSHEET 的单独工作表

Excel 代码要做什么：

如果任何列中的任何单元格值发生更改，那么我希望在复制/记录整个列的 LOGSHEET 中记录相同的值

例如，如果 INFY 股票的出价发生变化，则整个行（在这种情况下，行包含股票 INFY）应记录/复制到 LOGSHEET 中

示例： 2 INFY | 10.40am| 100 | 99 | 101

类似地，如果说另一个或相同脚本的要约价格或时间或最后交易率更改，则它会显示粘贴/记录在先前记录的条目下方，例如：

2 INFY     | 10.40am| 100           | 99.10        | 101
3 TECH     | 10.40am| 140.50           | 136       | 142

等等……

我不是 Excel VBA 程序员，但我发现这段代码记录了一些内容，但不是整个行的组织。

我找到了一个代码，它以一种杂乱无章的方式做类似的事情，但不是我想要的

示例代码：

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim strAddress As String
    Dim val
    Dim dtmTime As Date
    Dim Rw As Long

    If Intersect(Target, Range("A1:M1000")) Is Nothing Then Exit Sub
       'change range to suit
    dtmTime = Now()
    val = Target.Value
    strAddress = Target.Address


    Rw = Sheets("Log Sheet").Range("A" & Rows.Count).End(xlUp).Row + 1
    With Sheets("Log Sheet")
        .Cells(Rw, 1) = strAddress
        .Cells(Rw, 2) = val
        .Cells(Rw, 3) = dtmTime
        .Cells(Rw, 3) = Stocks
    End With
End Sub

Answer 1

将以下代码复制到 STOCKS 工作表模块中。如果其中的单元格值发生更改（未测试），这将跨行复制。

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim lRowLogSheet As Long

    'adjust the below target range to suit your needs
    If Intersect(Target, Range("C4:C8")) Is Nothing Then Exit Sub

    'find the last row in the log sheet
    lRowLogSheet = Sheets("LOGSSHEET").Range("A" & Sheets("LOGSSHEET").Rows.Count).End(xlUp).Row + 1

    'set the values of the row
    Sheets("LOGSSHEET").Range("A" & lRowLogSheet, "E" & lRowLogSheet).Value = Sheets("STOCKS").Range("A" & Target.Row, "E" & Target.Row).Value

End Sub

Answer 2

你就是这样做的：

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)

    Dim Rw As Long

    If Intersect(Target, Range("A1:M1000")) Is Nothing Then Exit Sub

    With ThisWorkbook.Sheets("Log Sheet")
        Rw = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
        Me.Rows(Target.Row).Copy .Cells(Rw, 1)
    End With

End Sub