如何将Yahoo Finance中的“费用比率”写入Excel(VBA)?

时间:2017-06-22 17:10:43

标签: excel vba excel-vba yahoo-finance yahoo-api

新手在这里。我在网上找到了一些有用的资源,关于如何将雅虎财经的股票关键财务网络划分为Excel。它工作得很好。但是,如何访问Yahoo Finance API中未定义的标记?具体而言,ETF或共同基金的“开支比率”是多少?

如果有帮助,这是我正在使用的教程: 链接:www.marketindex.com.au/yahoo-finance-api

代码如下,并附上截图。谢谢。

截图: 代码&电子表格:

http://imgur.com/a/KQ7oT

雅虎财经的ETF与股票:

http://imgur.com/a/Y6ENu

Sub GetData()

Dim QuerySheet As Worksheet
Dim DataSheet As Worksheet
Dim qurl As String
Dim i As Integer
Dim j As Integer
Dim k As Integer

Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.Calculation = xlCalculationManual

Set DataSheet = ActiveSheet

Range("C7").CurrentRegion.ClearContents
i = 7
qurl = "http://download.finance.yahoo.com/d/quotes.csv?s=" + Cells(i, 1)
i = i + 1
While Cells(i, 1) <> ""
    qurl = qurl + "+" + Cells(i, 1)
    i = i + 1
Wend
qurl = qurl + "&f=" + Range("C2")
Range("c1") = qurl
QueryQuote:
         With ActiveSheet.QueryTables.Add(Connection:="URL;" & qurl, Destination:=DataSheet.Range("C7"))
            .BackgroundQuery = True
            .TablesOnlyFromHTML = False
            .Refresh BackgroundQuery:=False
            .SaveData = True
        End With

j = Range("A7").End(xlDown).Row

For k = 7 To j

Cells(k, "C").Value = Replace(Cells(k, "C").Value, ", Inc. Common Stoc", "")
Cells(k, "C").Value = Replace(Cells(k, "C").Value, ", Inc. Common St", "")
Cells(k, "C").Value = Replace(Cells(k, "C").Value, ", Inc. Co St", "")
Cells(k, "C").Value = Replace(Cells(k, "C").Value, ", Inc. Co", "")
Cells(k, "C").Value = Replace(Cells(k, "C").Value, ", Inc. (The)", "")
Cells(k, "C").Value = Replace(Cells(k, "C").Value, ", Inc. Com", "")
Cells(k, "C").Value = Replace(Cells(k, "C").Value, ", Inc.", "")
Cells(k, "C").Value = Replace(Cells(k, "C").Value, ", Incorporated C", "")

Next

        Range("C7").CurrentRegion.TextToColumns Destination:=Range("C7"), DataType:=xlDelimited, _
            TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
            Semicolon:=False, Comma:=True, Space:=False, other:=False


'turn calculation back on
Application.Calculation = xlCalculationAutomatic
Application.DisplayAlerts = True
'    Range("C7:H2000").Select
'    Selection.Sort Key1:=Range("C8"), Order1:=xlAscending, Header:=xlGuess, _
'        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Columns("C:C").ColumnWidth = 25
Rows("7:2000").RowHeight = 16
Columns("J:J").ColumnWidth = 8.5
Range("h2").Select

End Sub

1 个答案:

答案 0 :(得分:1)

我确信这可以改进,但至少这是一个好的开始。

Sub DownloadData()

Set ie = CreateObject("InternetExplorer.application")

With ie
    .Visible = True
    .navigate "https://finance.yahoo.com/quote/AAPL/key-statistics?p=AAPL"

' Wait for the page to fully load; you can't do anything if the page is not fully loaded
Do While .Busy Or _
    .readyState <> 4
    DoEvents
Loop

' Set a reference to the data elements that will be downloaded. We can download either 'td' data elements or 'tr' data elements.  This site happens to use 'tr' data elements.
Set Links = ie.document.getElementsByTagName("tr")
RowCount = 1

    ' Scrape out the innertext of each 'tr' element.
    With Sheets("DataSheet")
        For Each lnk In Links
            .Range("A" & RowCount) = lnk.innerText
            RowCount = RowCount + 1
        Next
    End With
End With
MsgBox ("Done!!")

End Sub