添加新Excel工作表时出错400

Question

理想情况下，这个宏会遍历一个公司名称列表，每个公司名称都有一个日期范围，并创建一个包含每个公司信息的新标签，但我很难在这个宏的末尾创建一个新标签，如它给我一个错误400.

Sub getStockPrices()

Dim DataSheet As Worksheet
Dim EndDate As Date
Dim StartDate As Date
Dim Symbol As String
Dim Interval As String
Dim qurl As String
Dim nQuery As Name
Dim LastRow As Integer

Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.Calculation = xlCalculationManual

Sheets("data").Cells.Clear

Set DataSheet = ActiveSheet

    StartDate = DataSheet.Range("startDate").Value
    EndDate = DataSheet.Range("endDate").Value
    Symbol = DataSheet.Range("ticker").Value
    Interval = DataSheet.Range("Interval").Value
    Sheets("data").Range("a1").CurrentRegion.ClearContents

    qurl = "http://ichart.finance.yahoo.com/table.csv?s=" & Symbol
    qurl = qurl & "&a=" & Month(StartDate) - 1 & "&b=" & Day(StartDate) & _
        "&c=" & Year(StartDate) & "&d=" & Month(EndDate) - 1 & "&e=" & _
        Day(EndDate) & "&f=" & Year(EndDate) & "&g=" & Interval & "&q=q&y=0&z=" & _
        Symbol & "&x=.csv"

QueryQuote:
    With Sheets("data").QueryTables.Add(Connection:="URL;" & qurl, Destination:=Sheets("data").Range("a1"))
        .BackgroundQuery = True
        .TablesOnlyFromHTML = False
        .Refresh BackgroundQuery:=False
        .SaveData = True
    End With

    Sheets("data").Range("a1").CurrentRegion.TextToColumns Destination:=Sheets("data").Range("a1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        Semicolon:=False, Comma:=True, Space:=False, other:=False

     Sheets("data").Columns("A:G").ColumnWidth = 12

 End Sub

包含启动宏的字段的工作表图片。

我输入股票代码，日期范围，日或周价格，并调用Yahoo并使用此信息填充“数据”选项卡。我有一个情况，我需要运行这个数十家公司进行分析，但根据我现在设置的方式，我每次都要创建一个新的表格并复制数据。

如何循环浏览公司股票代码和日期范围列表，运行此代码，将其放入新工作表中并将公司股票代码命名为工作表，然后转到下一个公司？

或者至少，如何创建新标签并将其命名为刚刚运行的公司标题。

Answer 1

这是我对此的抨击。这期望找到名为Criteria的工作表，其具有命名范围调用TickerList。这是一列股票代码。 StartDate，EndDate和Interval位于每个符号右侧的单元格中。

Sub getStockPrices()

    Dim DataSheet As Worksheet
    Dim CriteriaSheet As Worksheet
    Dim EndDate As Date
    Dim StartDate As Date
    Dim Symbol As String
    Dim Interval As String
    Dim qurl As String
    Dim LastRow As Integer
    Dim myCell As Range

    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Application.Calculation = xlCalculationManual

    Set CriteriaSheet = ActiveWorkbook.Worksheets("Criteria")
    ' Iterate through the TickerList range
    ' creating a new sheet for each entry
    For Each myCell In CriteriaSheet.Range("TickerList")
        Symbol = myCell.Value
        StartDate = myCell.Offset(0, 1).Value
        EndDate = myCell.Offset(0, 2).Value
        Interval = myCell.Offset(0, 3).Value
        With ThisWorkbook
            Set DataSheet = .Sheets.Add(After:=.Sheets(.Sheets.Count))
            DataSheet.Name = Symbol
        End With
        qurl = "http://ichart.finance.yahoo.com/table.csv?s=" & Symbol
        qurl = qurl & "&a=" & Month(StartDate) - 1 & "&b=" & Day(StartDate) & _
        "&c=" & Year(StartDate) & "&d=" & Month(EndDate) - 1 & "&e=" & _
        Day(EndDate) & "&f=" & Year(EndDate) & "&g=" & Interval & "&q=q&y=0&z=" & _
        Symbol & "&x=.csv"
        With Sheets(Symbol).QueryTables.Add(Connection:="URL;" & qurl, Destination:=Sheets(Symbol).Range("a1"))
            .BackgroundQuery = True
            .TablesOnlyFromHTML = False
            .Refresh BackgroundQuery:=False
            .SaveData = True
        End With

        Sheets(Symbol).Range("a1").CurrentRegion.TextToColumns Destination:=Sheets(Symbol).Range("a1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        Semicolon:=False, Comma:=True, Space:=False, other:=False

    Sheets(Symbol).Columns("A:G").ColumnWidth = 12
    Next myCell
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    Application.Calculation = xlCalculationAutomatic
 End Sub