Как сохранить очищенные веб-данные в новый столбец Excel с помощью VBA

Question

У меня есть лист, на котором я собираю данные веб-страницы со столбцами из A: F

Я хочу поместить старые данные в столбец E, из столбца T и далее при каждом запуске модуля VBA

Я сделал сейчас что-то вроде

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

Нам нужно поставить

'КОПИЯ ЦЕНЫ. Call 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

---

Редактировать: Вот проверенный пример.Скажем, у меня есть некоторые данные в столбце E, начиная со строки 2 на листе "Sheet2".

Я могу использовать приведенный ниже код для копированиявставьте его в последний столбец (где последний столбец является либо столбцом 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

И это то, что я получаю после запускакод три раза - что я думаю, что вы хотите.