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

时间:2015-04-28 15:04:39

标签: excel vba add rows

在两个表数据下载之间'部分,第一个表的行数不固定。

如何添加VBA脚本以使其能够在第一个表的最后一个使用行之后立即自动添加五行,然后开始第二个表下载?

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

1 个答案:

答案 0 :(得分:0)

看起来你只想在每张桌子之间留出5行间距。这实际上不需要添加行。表格下方已有空白行。我建议只添加一个变量tblStartRow来跟踪当前表的第一行,并在Cells调用中使用该变量。我为第一个表设置该值为1,然后计算第二个表的新起始行值。

'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

此外,我认为将这些表分成他们自己的循环集是没有意义的,所以我将所有表导出组合起来(你会注意到我移动了我重新分配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评论的表格之间导出A列中的文本。