如何使用 vba 將網絡抓取的數據保存到新的 excel 列

Question

我有一張表格，其中包含 A:F 列的網頁數據

每次運行 VBA 模塊時，我想將舊數據放在 E 列中，從 T 列開始

我現在做了類似的事情

wks.Cells(i, "T").Value = wks.Cells(i, "E").Value

我怎樣才能讓它每次都前進？

完整代碼如下

For i = 2 To 17

LRandomNumber = Int((15 - 2 + 1) * Rnd + 2)

mylink = wks.Cells(i, 2).Value

ie.Navigate mylink



While ie.Busy Or ie.ReadyState < 4: DoEvents: Wend
t = Timer
Do
    DoEvents
    On Error Resume Next

    wks.Range(Cells(i, 1), Cells(i, 5)).Interior.ColorIndex = 38

    Set price = ie.Document.querySelector(".price-container .final-price")

    myprice = CCur(price.innerText)


    checkprice = myprice * 1.24


    'FORMAT PRICE
    If wks.Cells(i, "E").Value < checkprice Then wks.Cells(i, "E").Interior.ColorIndex = 3 Else wks.Cells(i, "E").Interior.ColorIndex = 4

    wks.Cells(i, "E").Value = myprice * 1.24

    Set availability = ie.Document.querySelector(".inner-box-one .availability")
    wks.Cells(i, "D").Value = availability.innerText

    Set product_name = ie.Document.querySelector(".title-container h1.title")
    wks.Cells(i, "C").Value = product_name.innerText

    If Timer - t > LRandomNumber Then Exit Do
    On Error GoTo 0
Loop
If price Is Nothing Then Exit Sub

wks.Range(Cells(i, 1), Cells(i, 5)).Interior.ColorIndex = 0

Next i

我們需要把

'COPY PRICE 調用 TransferDataFromColumnE(wks)

在 For 循環之外

Answer 1

未經測試，但我認為您可以通過以下方式確定包含數據的最后一列：

Dim lastColumn as long
lastColumn = wks.cells(1, wks.columns.count).end(xltoleft).column
lastColumn = application.max(lastColumn + 1, wks.columns("T").column)
' The Application.Max is meant to guarantee you either write to column T or any column to the right of it.
' +1 is so that we don't overwrite the last column, but instead write to the column after it.

然后你可以繼續你的代碼（盡管一次分配整個范圍/列而不是單獨分配每個單元格/行可能更好/更快）。

wks.Cells(i, lastColumn).Value = wks.Cells(i, "E").Value

---

編輯：這是一個經過測試的示例。 假設我在名為"Sheet2"的工作表的第 2 行開始的 E 列中有一些數據。

我可以使用下面的代碼將其復制粘貼到最后一列（最后一列是T列或它右側的第一個空列）。

Option Explicit

Sub TransferDataFromColumnE()

    Dim wks As Worksheet
    Set wks = ThisWorkbook.Worksheets("Sheet2")

    Dim lastColumn As Long
    lastColumn = wks.Cells(2, wks.Columns.Count).End(xlToLeft).Column
    lastColumn = Application.Max(lastColumn + 1, wks.Columns("T").Column)

    With wks.Range("E2:E24") ' This is the range I need to copy in my case
        Dim columnOffset As Long
        columnOffset = lastColumn - .Columns(1).Column

        .Copy
        .Offset(0, columnOffset).PasteSpecial xlPasteValuesAndNumberFormats
        Application.CutCopyMode = False
    End With

End Sub

這是我運行代碼 3 次后得到的結果——我認為這就是您想要的。