vba - 添加新 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