在网址中创建for循环以自动提取财务信息

问题描述

我有代码从Yahoo Finance中提取损益表和资产负债表。我还列出了对股票代码感兴趣的股票清单。 （例如U2：U20）。我希望能够自动将股票票证包含在宏中的url中。我还希望将结果放置在每种股票的新工作表中。这是手册代码。

Public Sub WriteoutBalancesheet()
    Dim http As Object,s As String

    Set http = CreateObject("MSXML2.XMLHTTP")

    With http
        .Open "GET","https://finance.yahoo.com/quote/CSIQ/balance-sheet?p=CSIQ",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")
    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("Sheet1")
    
    With ws
        .Cells(1,7).Resize(1,UBound(headers) + 1) = headers
        .Cells(2,7).Resize(UBound(results,1),UBound(results,2)) = results
    End With
End Sub

有什么想法吗？

解决方法

暂无找到可以解决该程序问题的有效方法，小编努力寻找整理中！

如果你已经找到好的解决方法，欢迎将解决方案带上本链接一起发送给小编。

小编邮箱:dio#foxmail.com (将#修改为@）