2017-06-22 49 views
1

新手在這裏。我在網上發現了一些有用的資源,介紹如何從雅虎財經網站刮取股票的關鍵財務數據到Excel。它的工作很棒。但是,如何訪問未在Yahoo Finance API中定義的標籤?具體而言,ETF或共同基金的「費用比率」?如何將雅虎財務的「費用比率」webscrape到Excel(VBA)?

這裏是我使用的是否有幫助教程: 鏈接:www.marketindex.com.au/yahoo-finance-api

代碼如下並附截圖。謝謝。

截圖: 代碼&電子表格:

http://imgur.com/a/KQ7oT

ETF VS股票在雅虎財經:

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

我敢肯定,這可以改進,但至少這是一個好的開始。

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