自动在最后一个非空/已用行下方添加一行或一个值

Question

在两个'table data download'部分之间，第一个table的行数不固定。

如何添加 VBA 脚本，使其在第一个 table 最后使用的行之后自动添加五行，然后开始第二个 table 下载？

Sub GetFinanceData()
For x = 1 To 5
Dim URL As String, elemCollection As Object
Dim t As Integer, r As Integer, c As Integer
Dim LastLine As Long
LastLine = Range("A1048576").End(xlUp).Row

Worksheets("Stocks").Select
Worksheets("Stocks").Activate

'Open IE and Go to the Website

URL = "http://stock.finance.sina.com.cn/hkstock/finance/00001.html"
URL = Cells(x, 1)

Set IE = CreateObject("InternetExplorer.Application")
With IE
    .navigate URL
    .Visible = True

Do While .Busy = True Or .readyState <> 4
    Loop
DoEvents

Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = _
ThisWorkbook.Worksheets("Stocks").Range("B" & x).Value

'Select the Report Type

Set selectItems = IE.Document.getElementsByTagName("select")
For Each i In selectItems
    i.Value = "zero"
    i.FireEvent ("onchange")
    Application.Wait (Now + TimeValue("0:00:05"))
Next i

Do While .Busy: DoEvents: Loop

ActiveSheet.Range("A1:K500").ClearContents

'Find and Get the First Table Data

Set elemCollection = .Document.getElementsByTagName("TABLE")
For t = 0 To (elemCollection.Length - 4)
    For r = 0 To (elemCollection(t).Rows.Length - 1)
        For c = 0 To (elemCollection(t).Rows(r).Cells.Length - 1)
ActiveSheet.Cells(r + 1, c + 1) = elemCollection(t).Rows(r).Cells(c).innerText
    Next c
    Next r
    Next t

'Find and Get the Second Table Data

Set elemCollection = .Document.getElementsByTagName("TABLE")
For t = 1 To (elemCollection.Length - 3)
    For r = 0 To (elemCollection(t).Rows.Length - 1)
        For c = 0 To (elemCollection(t).Rows(r).Cells.Length - 1)
ActiveSheet.Cells(r + 19, c + 1) = elemCollection(t).Rows(r).Cells(c).innerText
    Next c
    Next r
    Next t


'Find and Get the Third Table Data

Set elemCollection = .Document.getElementsByTagName("TABLE")
For t = 2 To (elemCollection.Length - 2)
    For r = 0 To (elemCollection(t).Rows.Length - 1)
        For c = 0 To (elemCollection(t).Rows(r).Cells.Length - 1)
ActiveSheet.Cells(r + 48, c + 1) = elemCollection(t).Rows(r).Cells(c).innerText
    Next c
    Next r
    Next t

'Find and Get the Fourth Table Data

Set elemCollection = .Document.getElementsByTagName("TABLE")
For t = 3 To (elemCollection.Length - 1)
    For r = 0 To (elemCollection(t).Rows.Length - 1)
        For c = 0 To (elemCollection(t).Rows(r).Cells.Length - 1)
ActiveSheet.Cells(r + 61, c + 1) = elemCollection(t).Rows(r).Cells(c).innerText
    Next c
    Next r
    Next t
End With

' cleaning up memory

IE.Quit

    Next x

End Sub

Answer 1

您似乎只想在每行之间留出 5 行间距 table。这实际上不需要添加行。 table 下方已有空白行。我建议只添加一个变量 tblStartRow 来跟踪当前 table 的第一行并在 Cells 调用中使用该变量。我将第一个 table 的值设置为 1，然后为第二个 table.

计算新的起始行值

'Find and Get the First Table Data

tblStartRow = 1
Set elemCollection = .Document.getElementsByTagName("TABLE")
For t = 0 To (elemCollection.Length - 4)
    For r = 0 To (elemCollection(t).Rows.Length - 1)
        For c = 0 To (elemCollection(t).Rows(r).Cells.Length - 1)
            ActiveSheet.Cells(r + tblStartRow, c + 1) = elemCollection(t).Rows(r).Cells(c).innerText
        Next c
    Next r
Next t

'Find and Get the Second Table Data

tblStartRow = tblStartRow + r + 4
Set elemCollection = .Document.getElementsByTagName("TABLE")
For t = 1 To (elemCollection.Length - 3)
    For r = 0 To (elemCollection(t).Rows.Length - 1)
        For c = 0 To (elemCollection(t).Rows(r).Cells.Length - 1)
            ActiveSheet.Cells(r + tblStartRow, c + 1) = elemCollection(t).Rows(r).Cells(c).innerText
        Next c
    Next r
Next t

此外，我认为将这些 table 分成它们自己的循环集没有意义，因此我将所有 table 导出合并为（您会注意到我将语句移到了重新分配的位置tblStartRow 的值):

tblNameArr = Array("Balance Sheet", "Cash Flow", "Header 3", "Header 4", "Header 5")
tblStartRow = 1
Set elemCollection = .Document.getElementsByTagName("TABLE")
For t = 0 To elemCollection.Length - 1
    For r = 0 To (elemCollection(t).Rows.Length - 1)
        For c = 0 To (elemCollection(t).Rows(r).Cells.Length - 1)
            ActiveSheet.Cells(r + tblStartRow, c + 1) = elemCollection(t).Rows(r).Cells(c).innerText
        Next c
    Next r
    ActiveSheet.Cells(r + tblStartRow + 2, 1) = tblNameArr(t)
    tblStartRow = tblStartRow + r + 4
Next t

我编辑了最后一个代码块以在每个 OP 评论 table 秒之间导出 A 列中的文本。

自动在最后一个非空/已用行下方添加一行或一个值

Automatically add a row or a value below the last non-empty / used row

excel

vba

add

rows