如何向雅虎财务提出多项要求来获得200个股票的上限?

我已经开发了一个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股票,并把它的数据,直到它已经经历了每一个符号?

此版本的function将一次将请求分解为最多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 

汤姆

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

希望这会有所帮助。 最好的祝福,