Vba 如何向Yahoo Finance发出多个请求以绕过200股的限制？

在另一个在线教程的帮助下，我开发了一个Excel表格，该教程从Yahoo Finance获取股票信息。以下是我目前掌握的代码：

Private Sub btnRefresh_Click()
Dim W As Worksheet: Set W = ActiveSheet
Dim Last As Integer: Last = W.Range("A1000").End(xlUp).Row
If Last = 1 Then Exit Sub
Dim Symbols As String
Dim i As Integer
For i = 2 To 200
    Symbols = Symbols & W.Range("A" & i).Value & "+"
Next i
Symbols = Left(Symbols, Len(Symbols) - 1)

Dim URL As String: URL = "http://finance.yahoo.com/d/quotes.csv?s=" & Symbols & "&f=sl1w1t8ee8rr5s6j4m6kjp5"
Dim Http As New WinHttpRequest
Http.Open "GET", URL, False
Http.Send

Dim Resp As String: Resp = Http.ResponseText
Dim Lines As Variant: Lines = Split(Resp, vbNewLine)
Dim sLine As String
For i = 0 To UBound(Lines)
    sLine = Lines(i)
    If InStr(sLine, ",") > 0 Then
        Values = Split(sLine, ",")
        W.Cells(i + 2, 4).Value = Values(1)
        W.Cells(i + 2, 5).Value = Right(Replace(Values(2), Chr(34), ""), 7)
        W.Cells(i + 2, 7).Value = Values(3)
        W.Cells(i + 2, 8).Value = Values(4)
        W.Cells(i + 2, 10).Value = Values(5)
        W.Cells(i + 2, 11).Value = Values(6)
        W.Cells(i + 2, 12).Value = Values(7)
        W.Cells(i + 2, 13).Value = Values(8)
        W.Cells(i + 2, 14).Value = Values(9)
        W.Cells(i + 2, 15).Value = Values(10)
        W.Cells(i + 2, 16).Value = Values(11)
        W.Cells(i + 2, 17).Value = Values(12)
        W.Cells(i + 2, 18).Value = Values(13)
    End If
Next i
W.Cells.Columns.AutoFit
End Sub

---

我遇到的问题是，如果A列中有200多个股票代码，它会返回一个错误，因为您无法发出包含200多个股票代码的请求。我的问题是如何修改此代码，使其能够请求前200只股票的信息，然后输入数据，然后移动到下200只股票并输入其数据，依此类推，直到它穿过每个符号？

您可以添加第二个循环索引j并指定上边界，如以下代码段所示：

    Dim W As Worksheet: Set W = ActiveSheet
    Dim Last As Integer: Last = W.Cells(W.Rows.Count, "A").End(xlUp).Row
    If Last = 1 Then Exit Sub
    Dim Symbols As String
    Dim i As Integer
    Dim j As Integer
    Dim jMax As Integer: jMax = Int(Last / 200)
    For j = 0 To jMax
        For i = 1 To 200
            If j * 200 + i <= Last Then
                Symbols = Symbols & W.Range("A" & j * 200 + i).Value & "+"
            End If
        Next i

Symbols = Left(Symbols, Len(Symbols) - 1)

Dim URL As String: URL = "http://finance.yahoo.com/d/quotes.csv?s=" & Symbols & "&f=sl1w1t8ee8rr5s6j4m6kjp5"
Dim Http As New WinHttpRequest
Http.Open "GET", URL, False
Http.Send

Dim Resp As String: Resp = Http.ResponseText
Dim Lines As Variant: Lines = Split(Resp, vbNewLine)
Dim sLine As String
For i = 0 To UBound(Lines)
    sLine = Lines(i)
    If InStr(sLine, ",") > 0 Then
        Values = Split(sLine, ",")
        W.Cells(i + 2, 4).Value = Values(1)
        W.Cells(i + 2, 5).Value = Right(Replace(Values(2), Chr(34), ""), 7)
        W.Cells(i + 2, 7).Value = Values(3)
        W.Cells(i + 2, 8).Value = Values(4)
        W.Cells(i + 2, 10).Value = Values(5)
        W.Cells(i + 2, 11).Value = Values(6)
        W.Cells(i + 2, 12).Value = Values(7)
        W.Cells(i + 2, 13).Value = Values(8)
        W.Cells(i + 2, 14).Value = Values(9)
        W.Cells(i + 2, 15).Value = Values(10)
        W.Cells(i + 2, 16).Value = Values(11)
        W.Cells(i + 2, 17).Value = Values(12)
        W.Cells(i + 2, 18).Value = Values(13)
    End If
Next i
W.Cells.Columns.AutoFit
    Next j

---

希望这会有所帮助。非常感谢，

此版本的函数将一次最多将请求分解为100个符号。在进入下一阶段之前，所有符号的结果将收集到Resp中

请注意，前面的响应有一个bug：符号200+的结果将覆盖第一批符号的结果

    Private Sub btnRefresh_Click()
    Dim W As Worksheet: Set W = ActiveSheet
    Dim Last As Integer: Last = W.Range("A1000").End(xlUp).Row
    If Last = 1 Then Exit Sub
    Dim Symbols As String
    Dim Resp As String
    Dim i As Integer
    Dim URL As String
    Dim Http As WinHttpRequest
    Resp = ""
    Symbols = ""
    For i = 2 To Last
        If Symbols <> "" Then Symbols = Symbols & "+"
        Symbols = Symbols & W.Range("A" & i).Value
        If i Mod 100 = 1 Or i = Last Then       ' do at most 100 symbols at a time
            URL = "http://finance.yahoo.com/d/quotes.csv?s=" & Symbols & "&f=sl1w1t8ee8rr5s6j4m6kjp5"
            Set Http = New WinHttpRequest
            Http.Open "GET", URL, False
            Http.Send
            Resp = Resp & Http.ResponseText
            Symbols = ""
        End If
    Next i
    Dim Lines As Variant: Lines = Split(Resp, vbNewLine)
    '' remaining code is unchanged

…汤姆