Google Finance から財務データを取得するマクロ

私がよく利用するサービスの一つであるグーグルファイナンス。全世界の企業データが同一フォーマットで見れるので重宝しています。

自分で何か分析する時はここからデータをエクセルにコピペして使っていたのですが、最近になって面倒くさいなあ、と思い始めたのでデータ吸出しの自動化にトライしてみました。

まず、エクセルにはWebクエリという機能があって、これで大抵のサイトのデータは取り込めますが残念ながらグーグルファイナンスではダメでした。
グーグルファイナンスのデータを吸い出すにはVBAマクロを使う必要があるようです。

VBAは全く触ったことがありませんしプログラムするのも超～久しぶりですが、仕方なくググりながらやってみました。以下手順です。

1.まず開発タブを表示します。開発タブの表示などを参考に設定します。

2.エクセルVBAでIEを操作するためには、以下のライブラリが必要となります。

Microsoft HTML Object Library
Microsoft Internet Controls

バージョンによっては設定が必要な場合があるので、エクセルVBAでIE(Internet Explorer)を操作する時に役に立つプロシージャまとめの「１．エクセルVBAの参照設定を行う」などを参考に設定します。なおExcel2013では不要でした。

3.開発タブの「マクロ」をクリックし、開発エディタに下記をコピペ。

#If VBA7 Then
Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal ms As LongPtr)
#Else
Private Declare Sub Sleep Lib "kernel32" (ByVal ms As Long)
#End If
'********************************************************
'プロシージャ名：urlClick
'プロシージャの説明：指定のURLをクリックする
'引数：objIE = 対象のIEオブジェクト
'　　：aTagStr = aタグ内の指定文字
'　　：ieTarget = IE表示方法（"_self"=同ウィンドウ、"_blank"＝別ウィンドウ）
'********************************************************
Sub urlClick(objIE As InternetExplorer, aTagStr As String, Optional ieTarget As String = "_self")

For Each objTag In objIE.document.getElementsByTagName("a")

If InStr(objTag.outerHTML, tagStr) > 0 Then

objTag.target = ieTarget

objTag.Click

Call ieCheck(objIE)

Exit For

End If
Next

End Sub

'********************************************************
'プロシージャ名：tagClick
'プロシージャの説明：指定のタグをクリックする
'引数：objIE = 対象のIEオブジェクト
'　　：tag = 検索するタグ名
' ：tagStr = タグ内の指定文字
'********************************************************
Sub tagClick(objIE As InternetExplorer, tag As String, tagStr As String)

For Each objTag In objIE.document.getElementsByTagName(tag)

If InStr(objTag.outerHTML, tagStr) > 0 Then

objTag.Click

Call ieCheck(objIE)

Exit For

End If
Next

End Sub

'********************************************************
'プロシージャ名：formText
'プロシージャの説明：テキストボックス、テキストエリアに値を入力する
'引数：objIE = 対象のIEオブジェクト
' ：idName = タグのid名
' ：tagValue = 入力する値
'********************************************************
Sub formText(objIE As InternetExplorer, idName As String, tagValue As String)

For Each objTag In objIE.document.getElementsByTagName("input")

If objTag.Name = idName Then
objTag.Value = tagValue
Exit For
End If
Next

For Each objTag In objIE.document.getElementsByTagName("textarea")

If objTag.Name = idName Then
objTag.Value = tagValue
Exit For
End If
Next

End Sub

'********************************************************
'プロシージャ名：ieCheck
'プロシージャの説明：IEが完全表示されまでループする
'引数：objIE = 対象のIEオブジェクト
'********************************************************
Sub ieCheck(objIE As InternetExplorer)

Dim timeout As Date

timeout = Now + TimeSerial(0, 0, 10)

Do While objIE.Busy = True Or objIE.ReadyState <> 4
DoEvents
Sleep 100
If Now > timeout Then
objIE.Refresh
timeout = Now + TimeSerial(0, 0, 10)
End If
Loop

timeout = Now + TimeSerial(0, 0, 10)

Do Until objIE.document.ReadyState = "complete"
DoEvents
Sleep 100
If Now > timeout Then
objIE.Refresh
timeout = Now + TimeSerial(0, 0, 10)
End If
Loop

End Sub
'********************************************************
'プロシージャ名：ieView
'プロシージャの説明：IE表示
'引数：objIE = 対象のIEオブジェクト
' ：urlName = 表示するURL
' ：viewFlg = 表示・非表示
' ：ieTop = ブラウザのTOP位置
' ：ieLeft = ブラウザのLEFT位置
' ：ieWidth = ブラウザの幅
' ：ieHeight = ブラウザの高さ
'********************************************************
Sub ieView(objIE As InternetExplorer, urlName As String, Optional viewFlg As Boolean = True, Optional ieTop As Integer = 0, Optional ieLeft As Integer = 0, Optional ieWidth As Integer = 600, Optional ieHeight As Integer = 600)

Set objIE = CreateObject("InternetExplorer.Application")

objIE.Visible = viewFlg

objIE.Top = ieTop
objIE.Left = ieLeft
objIE.Width = ieWidth
objIE.Height = ieHeight

objIE.Navigate urlName

Call ieCheck(objIE)

End Sub

Sub get_financials()
'
' GET google finance
'
'
    Dim y As Long
    Dim x As Long
    Dim now_item As String
    Dim ret_num, now_retcolumn As Long
    Dim ret_keyword As Variant
    Dim ret_column As Variant

    ret_num = 0
    now_retcolumn = 5

    ret_keyword = Array("Revenue ", "Revenue ", "Cash & Equivalents ", "Cash & Equivalents ", "Net Income/Starting Line ", "Net Income/Starting Line ", "Dummy")
    ret_column = Array(5, 4, 5, 4, 4, 4)

    Dim objITEM As Object
    Dim objIE As New InternetExplorer
    objIE.Visible = False

    Call ieView(objIE, "http://www.google.com/finance", True)
    Call formText(objIE, "q", Range("B1").Value)
    Call tagClick(objIE, "button", "Google Search")
    Call tagClick(objIE, "a", "Financials")

    'アクティブなシートのA3～F200の範囲を全てクリア
    Range("A2:F300").Select
    Selection.ClearContents
    Range("A3").Select

    y = 2
    x = 1

    For Each objITEM In objIE.document.getElementsByTagName("td")
        now_item = objITEM.innerText

        '折り返し設定
        If now_item = ret_keyword(ret_num) Then
            now_retcolumn = ret_column(ret_num)
            ret_num = ret_num + 1
            x = 1
        End If

        Cells(y, x) = now_item
        x = x + 1


        If x - 1 > now_retcolumn Then
            x = 1
            y = y + 1
        End If
    Next
    objIE.Quit
    Set objITEM = Nothing
    Set objIE = Nothing
    Range("B1").Select
'

End Sub
Sub untilReady(objIE As Object, Optional ByVal WaitTime As Integer = 10)
    Dim starttime As Date
    starttime = Now()
    Do While objIE.Busy = True Or objIE.ReadyState <> READYSTATE_COMPLETE
        DoEvents
        If Now() > DateAdd("S", WaitTime, starttime) Then
            Exit Do
        End If
    Loop
    DoEvents
End Sub

以上で準備は完了です。

B1セルにティッカー（米株のみ）を入力して get_financials() を実行すると、カレントのシートに

P/L 四半期
P/L 年間
B/S 四半期
B/S 年間
C/F 四半期
C/F 年間

の順にデータが取得されます。あとは煮るなり焼くなり。

一応、マクロ起動ボタンを配置したファイルを作ってみました。B1にティッカーを入れて「取り込み」ボタンを押すと実行されます。

ほとんどオボった（いや今ならサノったか）だけで自作はわずかですが、まあ何とか目的は達成できました。

「いいね！」はこちらのクリックで代用して頂けたら嬉しいです