Excel VBA根据名称列表添加并命名多个工作表 [英] Excel VBA add and name multiple sheets according to a list of names

问题描述

我制作了一个VBA脚本，可以根据网站列表下载表格数据.现在的问题是:如何根据名称列表命名工作表.该代码已经包含添加工作表功能，工作表名称列表在工作表股票"中，从单元格B1开始.预先感谢！

I made a VBA script which can download table data according to a list of website. Now the problem is: how to name the sheets according to a list of names. This code already contains the add sheets function, and the list of sheet names is in the sheet "Stocks", starting from cell B1. Thanks in advance!

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

推荐答案

尝试一下:

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

这篇关于Excel VBA根据名称列表添加并命名多个工作表的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！