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股票的出价发生变化，则应在LOGSHEET中记录/复制整个行（在这种情况下，包含INFY股票的行）

示例： 2 INFY |上午10.40 | 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

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

2 个答案: