Warning: file_get_contents(/data/phpspider/zhask/data//catemap/1/cocoa/3.json): failed to open stream: No such file or directory in /data/phpspider/zhask/libs/function.php on line 167

Warning: Invalid argument supplied for foreach() in /data/phpspider/zhask/libs/tag.function.php on line 1116

Notice: Undefined index: in /data/phpspider/zhask/libs/function.php on line 180

Warning: array_chunk() expects parameter 1 to be array, null given in /data/phpspider/zhask/libs/function.php on line 181
Excel 使用VBA错误下标超出范围自动提取yahoo finance财务信息_Excel_Vba - Fatal编程技术网

Excel 使用VBA错误下标超出范围自动提取yahoo finance财务信息

Excel 使用VBA错误下标超出范围自动提取yahoo finance财务信息,excel,vba,Excel,Vba,你好首先我对VBA很陌生。我有这个代码从雅虎财经中提取财务信息。我正在尝试为列表A1:A500中格式化的股票代码自动执行此操作。我希望宏获取这些信息并自动将其打印到每个公司的新工作表中,但我似乎无法使其正常工作。任何帮助都将不胜感激 Public Sub WriteOutFinancialInfo() Dim http As Object, s As String, i As Integer, st As String, rng As Range, surl As String, sta

你好首先我对VBA很陌生。我有这个代码从雅虎财经中提取财务信息。我正在尝试为列表A1:A500中格式化的股票代码自动执行此操作。我希望宏获取这些信息并自动将其打印到每个公司的新工作表中,但我似乎无法使其正常工作。任何帮助都将不胜感激

Public Sub WriteOutFinancialInfo()
    Dim http As Object, s As String, i As Integer, st As String, rng As Range, surl As String, start As String, last As String

    Set http = CreateObject("MSXML2.XMLHTTP")
    
    For i = 1 To 500
           For Each rng In Range("A2:A500")
           i = i + 1
           st = Worksheets("Sheet1").Cells(i, 1)
           st = st & ""
           Next rng
    Next i
    start = "https://finance.yahoo.com/quote"
    last = "/financials?p="
    surl = start & st & last & st
    
           
           
           
        
            With http
                .Open "GET", surl, False
                .setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
                .send
                s = .responseText
            End With
            
            Dim html As MSHTML.HTMLDocument, html2 As MSHTML.HTMLDocument, re As Object, matches As Object
            
            Set html = New MSHTML.HTMLDocument: Set html2 = New MSHTML.HTMLDocument
            Set re = CreateObject("VBScript.RegExp")
            
            html.body.innerHTML = s
            
            Dim headers(), rows As Object
            
            headers = Array("Breakdown", "TTM")
            Set rows = html.querySelectorAll(".fi-row")
            
            With re
                .Global = True
                .MultiLine = True
                .Pattern = "\d{1,2}/\d{1,2}/\d{4}"
                Set matches = .Execute(s)
            End With
            
            Dim results(), match As Object, r As Long, c As Long, startHeaderCount As Long
            startHeaderCount = UBound(headers)
            ReDim Preserve headers(0 To matches.Count + startHeaderCount)
        
            c = 1
            For Each match In matches
                headers(startHeaderCount + c) = match
                c = c + 1
            Next
            
            Dim row As Object
            ReDim results(1 To rows.Length, 1 To UBound(headers) + 1)
         
            For r = 0 To rows.Length - 1
                html2.body.innerHTML = rows.Item(r).outerHTML
                Set row = html2.querySelectorAll("[title],[data-test=fin-col]")
                
                For c = 0 To row.Length - 1
                    results(r + 1, c + 1) = row.Item(c).innerText
                Next c
            Next
            
            Dim ws As Worksheet
            
            Set ws = ThisWorkbook.Worksheets("Sheet '&' i-1")
            
            With ws
                .Cells(1, 1).Resize(1, UBound(headers) + 1) = headers
                .Cells(2, 1).Resize(UBound(results, 1), UBound(results, 2)) = results
            End With
    
End Sub
我得到编译错误,下标超出范围,在第9行

ReDim results(1 To rows.Length, 1 To UBound(headers) + 1)
我不知道如何修理它。我也确信代码中有很多错误,所以如果有人看到任何错误,请告诉我。谢谢