Question

我制作了一个VBA脚本，可以根据网站列表下载表格数据。现在的问题是：如何根据名称列表命名工作表。此代码已包含添加工作表功能，工作表名称列表位于工作表＆＃34; Stocks＆＃34;中，从单元格B1开始。提前谢谢！

Sub GetFinanceData()
For x = 1 To 5
Dim URL As String, elemCollection As Object
Dim t As Integer, r As Integer, c As Integer

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)

Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = x

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

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

'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

试试这个：

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

Excel VBA根据名称列表添加和命名多个工作表

1 个答案: