Question

我已经开发了Excel表格（在另一个在线教程的帮助下），从雅虎财经中提取股票信息。这是我到目前为止的代码：

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个股票并输入其数据等等，直到它通过每个符号？

Answer 1

您可以添加第二个循环（索引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

希望这会有所帮助。最好的问候，

Answer 2

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

请注意，之前的回复有一个错误：符号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

...汤姆

如何向雅虎财经提出多个请求以绕过200个股票限额？

2 个答案: