从morningstar.com拉出上行/下行捕获比率

时间:2013-04-05 22:00:57

标签: javascript dynamic excel-vba build-automation finance

第一次很长时间。

这个VBA的新东西,无论如何都在流行。

我有兴趣提高很多共同基金的上行/下行捕获率,并希望自动化这一过程。 我从中获取信息的表格不是典型的表格;我想这是晨星网站上的“动态对象” 这是网站。

http://performance.morningstar.com/fund/ratings-risk.action?t=FDSAX&region=USA&culture=en-us

这特别适用于SunAmerica的Focus Dividend Fund;但是我想为很多基金做这件事 这就是我现在对代码的看法;我得到了msgbox,但不知道如何循环并获取有关excel的信息。

Private Sub Worksheet_Change(ByVal Target As Range)
  If Target.Column=Range("upDown").Row And _
  Target.Column= Range("upDown").Column Then

  Dim IE as New InternetExplorer
  IE.Visible=False
  IE.navigate "http://performance.morningstar.com/fund/ratings-risk.action?t=" _
     & Range("upDown").Value

  Do
    DoEvents
  Loop Until IE.readyState = READYSTATE_Complete
    Dim Doc as HTMLDocument
    Set Doc = IE.document
    Dim sTR As String 'got the "TR" from google chrome inspect element
    sTR = Trim(Doc.getElementsByTagName("tr")(45).innerText)

这是我被困的地方。我知道我需要使用'split'来排序我需要的每个数据项。示例1年上行1年下行3年上行3年下行。

所以一旦我在excel上获得它,我需要excel运行我的所有代码...大约1500来拉取数据,因为它每月更新一次。

提前感谢你......你将成为一个救命的人......如果我不明白的话,我可能会自己开枪:)

1 个答案:

答案 0 :(得分:2)

尝试以下代码。

Sub Test()

    Dim IE As Object, Doc As Object, lastRow As Long, tblTR As Object, tblTD As Object, strCode As String
    lastRow = Range("A65000").End(xlUp).Row


    Set IE = CreateObject("internetexplorer.application")
    IE.Visible = True


    For i = 1 To lastRow

        strCode = "FDSAX"    ' Range("A" & i).value  ' kindly change it as per your requirement. Currently hardcoded

        IE.navigate "http://performance.morningstar.com/fund/ratings-risk.action?t=" & "FDSAX"

        Do While IE.readystate <> 4: DoEvents: Loop

        Set Doc = CreateObject("htmlfile")
        Set Doc = IE.document

tryAgain:
        Set tblTR = Doc.getelementbyid("div_upDownsidecapture").getelementsbytagname("tr")(3)

        If tblTR Is Nothing Then GoTo tryAgain

        j = 2
        For Each tblTD In tblTR.getelementsbytagname("td")
            tdVal = Split(tblTD.innerText, vbCrLf)
            Cells(i, j) = tdVal(0)
            Cells(i, j + 1) = tdVal(1)
            j = j + 2
        Next


    Next
End Sub