非编程背景求助：Excel实时价格转置列并动态复制变动单元格

Hey there! I get that you're new to coding and English isn't your first language, so I'll keep this clear and straightforward. Let's fix up your VBA code to meet your needs: tracking real-time prices from datafeed!B2:B400, handling transposition, and dynamically recording only cells that change.

First, Let's Align on Your Goal #

You want to:

• Check the real-time prices in datafeed!B2:B400 every 1 second
• Transpose the vertical column of prices into a horizontal row for your records (since transposing swaps rows and columns)
• Only log cells whose prices have changed since the last check

Step 1: Prep a Hidden Sheet to Track Previous Prices #

We need a way to remember what prices were recorded last time. Let's create a hidden sheet for this:

1. Right-click any sheet tab > Insert > Worksheet > Name it LastPrices
2. Right-click the LastPrices tab > Hide (so it doesn't clutter your workbook)

Step 2: Full VBA Code to Implement Your Needs #

Open the VBA editor (press Alt + F11), insert a new module (Insert > Module), then paste this code:

' Global variable to manage the timer
Dim nextCheckTime As Date

Sub StartPriceTracking()
    ' Initialize the hidden LastPrices sheet with current prices first
    Sheets("datafeed").Range("B2:B400").Copy
    Sheets("LastPrices").Range("A2").PasteSpecial Paste:=xlPasteValues
    Application.CutCopyMode = False
    
    ' Start the 1-second check cycle
    nextCheckTime = Now + TimeValue("00:00:01")
    Application.OnTime nextCheckTime, "LogPriceChanges"
    MsgBox "Price tracking started! Check the 'record' sheet for updates."
End Sub

Sub LogPriceChanges()
    Dim dataSheet As Worksheet, recordSheet As Worksheet, lastPricesSheet As Worksheet
    Dim targetCell As Range
    Dim nextEmptyRow As Long
    Dim currentPrice As Variant, lastRecordedPrice As Variant
    
    ' Set easy references to our sheets (makes code simpler to follow)
    Set dataSheet = Sheets("datafeed")
    Set recordSheet = Sheets("record")
    Set lastPricesSheet = Sheets("LastPrices")
    
    ' Turn off screen updates to make the code run faster
    Application.ScreenUpdating = False
    
    ' Find the next empty row in the record sheet
    nextEmptyRow = recordSheet.Cells(recordSheet.Rows.Count, 1).End(xlUp).Row + 1
    
    ' Check each price cell in B2:B400
    For Each targetCell In dataSheet.Range("B2:B400")
        currentPrice = targetCell.Value
        lastRecordedPrice = lastPricesSheet.Cells(targetCell.Row, 1).Value
        
        ' Log the change only if the price is different and not empty
        If currentPrice <> lastRecordedPrice And Not IsEmpty(currentPrice) Then
            ' Write details to the record sheet: Timestamp, Cell Address, Old Price, New Price
            recordSheet.Cells(nextEmptyRow, 1).Value = Now
            recordSheet.Cells(nextEmptyRow, 2).Value = targetCell.Address
            recordSheet.Cells(nextEmptyRow, 3).Value = lastRecordedPrice
            recordSheet.Cells(nextEmptyRow, 4).Value = currentPrice
            
            ' Format the timestamp for readability
            recordSheet.Cells(nextEmptyRow, 1).NumberFormat = "yyyy-mm-dd hh:mm:ss"
            
            ' Move to the next empty row for the next change
            nextEmptyRow = nextEmptyRow + 1
            
            ' Update the hidden sheet with the new price for next check
            lastPricesSheet.Cells(targetCell.Row, 1).Value = currentPrice
        End If
    Next targetCell
    
    ' Optional: Uncomment below to add a full transposed snapshot every second
    ' nextEmptyRow = recordSheet.Cells(recordSheet.Rows.Count, 6).End(xlUp).Row + 1
    ' recordSheet.Cells(nextEmptyRow, 6).Value = Now ' Snapshot timestamp
    ' dataSheet.Range("B2:B400").Copy
    ' recordSheet.Cells(nextEmptyRow, 7).PasteSpecial Paste:=xlPasteValues, Transpose:=True
    ' Application.CutCopyMode = False
    
    ' Turn screen updates back on
    Application.ScreenUpdating = True
    
    ' Schedule the next check in 1 second
    nextCheckTime = Now + TimeValue("00:00:01")
    Application.OnTime nextCheckTime, "LogPriceChanges"
End Sub

Sub StopPriceTracking()
    ' Safely stop the automatic checks
    On Error Resume Next ' Avoid error if timer isn't running
    Application.OnTime nextCheckTime, "LogPriceChanges", Schedule:=False
    On Error GoTo 0
    MsgBox "Price tracking stopped!"
End Sub

Step 3: How to Use This Code #

1. Return to Excel, press Alt + F8 to open the macro list
2. Run StartPriceTracking to begin monitoring prices
3. Run StopPriceTracking whenever you want to end the automatic checks

Quick Explanation of Key Parts #

• StartPriceTracking: Sets up initial price data and starts the 1-second check cycle
• LogPriceChanges:
  • Compares current prices to the last recorded values
  • Logs only changed prices with timestamps and details in the record sheet
  • Updates the hidden sheet for future comparisons
  • Optional: The commented transpose code adds a full horizontal snapshot of all prices every second
• StopPriceTracking: Turns off the timer cleanly

Pro Tips for Your Workbook #

• Add headers to row 1 of the record sheet: Timestamp, Cell, Old Price, New Price (and Snapshot Timestamp, B2 Price, B3 Price, etc. if you use the transpose option)
• If you get an error about the LastPrices sheet, double-check that you created and hid it correctly

内容的提问来源于stack exchange，提问作者gromska