エクセルで株価を自動取得するＶＢＡコードを紹介します。（日本株・米国株・投信対応版）
ヤフーファイナンスの仕様変更に伴い、2018/5/12以前に記載されていたＶＢＡコードならびにダウンロードしたエクセルファイルでは米国株式ならびに米国ＥＴＦのデータ取得が出来なくなっております。
ＶＢＡコードの81～97行目のデータ取得の内容をフォローするか、エクセルファイル（Ｖ３．０７）の再ダウンロードをしていただけるようお願いします。
株価や投信の基準価額を自動取得できます。
僕は日本株の個別銘柄を、富士宮応援ファンドで15銘柄、好配当目的で41銘柄、合わせて56銘柄を保有しております。いずれも単元未満株ですが…
証券会社の一覧だと少々見づらいので、自分用にカテゴリー毎に分けてエクセルシートで管理しています。
ボタンをクリックすると、ヤフーファイナンス（日本株・投信）またはグーグルファイナンス（米国株）から、最新の株価や基準価額を自動取得できるようになっています。
以前紹介していたＶＢＡコードは、取得できるのは東証上場の株式・ＥＴＦの株価だけで、動作時間も１銘柄あたり数秒かかっておりました。
今回紹介するものは、米国上場している株式・ＥＴＦの株価や、国内投資信託の基準価額も自動取得することができ、また動作時間も１銘柄あたり１～１．５秒程度に短縮されています。
ＶＢＡコードの内容としては、上のサンプルシートに記載してある銘柄コードを元に、ヤフーファイナンスまたはグーグルファイナンスのHTMLソースを読み込んで、株価情報を取得しています。
バージョンアップ履歴
ヤフーファイナンスのデータフォーマット仕様変更により株価データが取得できなくなったのを解消。
グーグルファイナンスの仕様変更により米国株情報の取得が困難になったため、再び米ヤフーファイナンスから取得できるように変更。（米ヤフーファイナンスのリダイレクトエラーが解消されていたので…）
株価指数の指定はNYダウ(^DJI)やS&P500指数(^GSPC)などで対応可能。
またJPY=Xでドル円レートが取得可能になった。
2017/12/21時点でリダイレクトにて動作できているが正規URLに変更。
ヤフーファイナンスのURLをHTTP⇒HTTPSに変更。
グーグルファイナンスのURLをhttp://www⇒https://financeに変更。
投資信託の基準価額が前日比０（表示上="---"）の時にエラーになるのを解消。
米ヤフーファイナンスへアクセスしようとするとリダイレクトエラーが出てしまい、XMLHTTPバージョンやURLをいろいろ変えて試したが解消されなかったため、米国株式はグーグルファイナンスから取得するようにしました。
またこの変更に伴い、NYダウ(.DJI)やS&P500指数(.INX)などにも対応できるようになっています。
ヤフーファイナンスへの頻繁アクセスによるアクセス拒否を防止する目的でデータ取得間隔として０．５秒間のタイマーを設けてみました。
国内株式の地方証券取引所（札証・名証・福証）の対応をしました。
地方証券取引所の銘柄の場合は、銘柄コード末尾に下記2文字を付け足してください。
- 名古屋証券取引所（セントレックス含む）：.N
- 札幌証券取引所（アンビシャス含む）：.S
- 福岡証券取引所（Q-Board含む）：.F
（例）名証の【1413】桧家ホールディングスなら 1413.N
ＶＢＡコードです。
Sub ボタン1_Click()
Dim url As String
Dim code As String
Dim sosa_sh As Worksheet
Dim check_row, code_column As Integer
Dim now_price_column, old_price_column As Integer
Dim org_color As Integer
Dim http As Object
Dim check_txt, get_txt As String
Dim st_point, ed_point As Long
Dim price_txt, old_price_txt, tmp_txt As String
Dim t As Single ' 頻繁ｱｸｾｽ対策 20170331追加
Set sosa_sh = ActiveSheet ' 現在のシートを退避
check_row = 8 ' 8行目から株価取得開始
code_column = 4 ' 識別ｺｰﾄﾞの列
now_price_column = 5 ' 現在株価/基準価額の列
old_price_column = 6 ' 前日株価/基準価額の列
Set http = CreateObject("MSXML2.ServerXMLHTTP")
' コード記載がなくなるまで繰り返す
Do While sosa_sh.Cells(check_row, code_column) <> ""
' コード取得してURL設定
code = sosa_sh.Cells(check_row, code_column)
org_color = sosa_sh.Cells(check_row, now_price_column).Interior.ColorIndex ' ｾﾙの色番号を一時退避
sosa_sh.Cells(check_row, now_price_column).Interior.ColorIndex = 6 ' ｾﾙを黄色に塗る
If Len(code) <> 8 Then 'ｺｰﾄﾞが8桁以外の時(日本株式の時)
If IsNumeric(Left(code, 4)) Then ' ｺｰﾄﾞ左4桁が数値の時
If IsNumeric(code) Then ' ｺｰﾄﾞが数値の時
url = "https://stocks.finance.yahoo.co.jp/stocks/detail/?code=" & code & ".T"
' ﾔﾌｰﾌｧｲﾅﾝｽの株価情報を東証コードをつけて読み込み開始
' http⇒httpsアドレス対応 20171221変更
Else ' ｺｰﾄﾞに市場ｺｰﾄﾞが付与されている時
url = "https://stocks.finance.yahoo.co.jp/stocks/detail/?code=" & code
' ﾔﾌｰﾌｧｲﾅﾝｽの株価情報を読み込み開始
' http⇒httpsアドレス対応 20171221変更
End If
Else ' ｺｰﾄﾞが数値でない時(米国株式の時)
url = "https://finance.yahoo.com/quote/" & code
' ↑ ﾔﾌｰﾌｧｲﾅﾝｽからの取得するように変更 20180322変更
End If
Else 'ｺｰﾄﾞが8桁の時(投資信託の時)
url = "https://stocks.finance.yahoo.co.jp/stocks/detail/?code=" & code
' ﾔﾌｰﾌｧｲﾅﾝｽの投信情報を読み込み開始
' http⇒httpsアドレス対応 20171221変更
End If
' ---- 20170331 頻繁ｱｸｾｽ対策 start --------
t = Timer()
While Timer() < t + 0.5 ' 0.5秒間待機する
DoEvents
Wend
' ---- 20170331 頻繁ｱｸｾｽ対策 end --------
' ﾔﾌｰﾌｧｲﾅﾝｽをHTML形式で読み込む
http.Open "GET", url, False
http.setRequestHeader "If-Modified-Since", "Thu, 01 Jun 1970 00:00:00 GMT"
http.setTimeouts 5000, 5000, 5000, 5000
http.Send
If Len(code) <> 8 Then 'ｺｰﾄﾞが8桁以外の時(株式の時)
If IsNumeric(Left(code, 4)) Then ' ｺｰﾄﾞ左4桁が数値の時
' 目印の"stoksPrice"">"の位置から現在株価を取得
check_txt = "stoksPrice"">"
st_point = InStr(1, http.responseText, check_txt) + Len(check_txt)
ed_point = InStr(st_point, http.responseText, "</td>")
price_txt = Mid(http.responseText, st_point, ed_point - st_point)
' 目印の"innerDate"と"前日終値"の位置から前日株価を取得
st_point = InStr(1, http.responseText, "innerDate")
ed_point = InStr(st_point, http.responseText, "前日終値")
tmp_txt = Mid(http.responseText, st_point, ed_point - st_point)
check_txt = "<strong>"
st_point = InStr(1, tmp_txt, check_txt) + Len(check_txt)
ed_point = InStr(st_point, tmp_txt, "</")
old_price_txt = Mid(tmp_txt, st_point, ed_point - st_point)
Else ' ｺｰﾄﾞが数値でない時(米国株式の時)
'---- ヤフーファイナンスフォーマット変更対応 20180513変更start ----
' 目印のCurrency in USDの位置から現在株価を取得
check_txt = "Currency in USD"
st_point = InStr(1, http.responseText, check_txt) + Len(check_txt)
check_txt = "data-reactid=""35"">"
st_point = InStr(st_point, http.responseText, check_txt) + Len(check_txt)
ed_point = InStr(st_point, http.responseText, "</span>")
price_txt = Mid(http.responseText, st_point, ed_point - st_point)
' 目印のPrevious Closeの位置から前日株価を取得
check_txt = "Previous Close"
st_point = InStr(1, http.responseText, check_txt) + Len(check_txt)
check_txt = "data-reactid=""41"">"
st_point = InStr(st_point, http.responseText, check_txt) + Len(check_txt)
ed_point = InStr(st_point, http.responseText, "</span>")
old_price_txt = Mid(http.responseText, st_point, ed_point - st_point)
'---- ヤフーファイナンスフォーマット変更 20180513変更start ----
End If
' 取引があった時、当日終値を取得
If price_txt <> "---" Then
sosa_sh.Cells(check_row, now_price_column) = CDbl(price_txt)
Else ' 取引がなかった時
sosa_sh.Cells(check_row, now_price_column) = CDbl(old_price_txt)
End If
sosa_sh.Cells(check_row, old_price_column) = CDbl(old_price_txt)
Else 'ｺｰﾄﾞが8桁の時(投資信託の時)
' 目印の"stoksPrice"">"の位置から基準価額を取得
check_txt = "stoksPrice"">"
st_point = InStr(1, http.responseText, check_txt) + Len(check_txt)
ed_point = InStr(st_point, http.responseText, "</td>")
price_txt = Mid(http.responseText, st_point, ed_point - st_point)
' 目印の"前日比</span>"の位置から前日比を取得
check_txt = "前日比</span>"
st_point = InStr(1, http.responseText, check_txt) + Len(check_txt)
check_txt = "<span"
If Mid(http.responseText, st_point, Len(check_txt)) = check_txt Then
st_point = InStr(st_point, http.responseText, ">") + 1
End If
ed_point = InStr(st_point, http.responseText, "（")
old_price_txt = Mid(http.responseText, st_point, ed_point - st_point)
'---- 投信前日比0の対応 20171008変更start ----
If old_price_txt = "---" Then ' 前日比が"---"の時
old_price_txt = 0 ' 前日比0にする
End If
'---- 投信前日比0の対応 20171008変更end ----
sosa_sh.Cells(check_row, now_price_column) = CDbl(price_txt)
'現在基準価額と前日比から前日基準価額を算出
sosa_sh.Cells(check_row, old_price_column) = CDbl(price_txt) - CDbl(old_price_txt)
End If
sosa_sh.Cells(check_row, now_price_column).Interior.ColorIndex = org_color ' 退避していたｾﾙの色を戻す
check_row = check_row + 1 ' 次の行の株価取得へ
Loop
Set oHttp = Nothing
End Sub
エクセルシートの様式に伴うカスタマイズ。
ここでシートに合わせて、カスタマイズする必要があるポイントは４つ。
上のＶＢＡコードの14～17行目にある以下の部分です。
check_row = 8 ' 8行目から株価取得開始
code_column = 4 ' 識別ｺｰﾄﾞの列
now_price_column = 5 ' 現在株価/基準価額の列
old_price_column = 6 ' 前日株価/基準価額の列
check_row = 8
これはエクセルシートで、識別コードの記載が始まっている行を設定します。
最初にあったエクセルシートだと、先頭銘柄のアマゾンのティッカーAMZNがシートの8行目から書かれているので8を設定してます。
code_column = 4
これはエクセルシートで、識別コードの記載が始まっている列を設定します。
列の場合は、A列=1,B列=2,C列=3･･･というように数えます。
最初にあったエクセルシートだと、銘柄コードが書かれているのがD列なので4を設定しています。
now_price_column = 5
これは取得した最新株価や最新基準価額を書き込む列を設定します。
列の場合は、A列=1,B列=2,C列=3･･･というように数えます。
最初にあったエクセルシートだと、最新株価はE列に書き込むので5を設定しています。
old_price_column = 6
これは取得した前日株価や前日基準価額を書き込む列を設定します。
列の場合は、A列=1,B列=2,C列=3･･･というように数えます。
最初にあったエクセルシートだと、前日株価はF列に書き込むので6を設定しています。
使用にあたり注意点です。
銘柄コードが空白になっていることを条件にして、株価取得を終了するようになっています。
売却したりして銘柄を削除する場合は、空白行にせずに、行削除等で上に詰めるようにしてください。
ヤフーファイナンスのフォーム自体がいつか変わった場合、このＶＢＡコードでは使えなくなってしまうかもしれません。
その時は、新フォームに対応したものを紹介するつもりですが、なお、僕自身は米国株や投信の管理をしているわけではないので、障害発生に気付かない場合がありますので、コメント等で教えていただけるとありがたいです。
また、障害発生時にすぐには対応できない場合があります。
米国株や投信には対応できておりませんが、こちらの旧記事で紹介している旧ＶＢＡコードでは動作するかもしれません。（１銘柄あたり５～１０秒かかってしまいますが…）
もしものときの株価自動取得ＶＢＡコード(旧低速版)です ｜ 富士宮で貯蓄と資産運用
本記事は株価取得VBAコードの旧記事となっており、ヤフーファイナンスのHTMLフォーマットが変更になった際、新VBAコード（高速化・米国株対応・投信対応）が、正常動作しなくなった場合に備えて、用意してあるものです...
僕自身は今回紹介したコードが起動するボタンを【Quick Mode】、旧コードが起動するボタンを【Safety Mode】として、シート上に２つのボタンを用意して使っています。
マクロ釦の作り方や、ＶＢＡコード記述のやり方など、エクセル操作については書籍・ネット等で調べるようにしてください。
また、ＰＥＲ等など他項目を取得したいなどのご要望に都度対応することはできません。
サンプルシートとＶＢＡコードがダウンロードできます。
サンプルシートとＶＢＡコードが記載されたエクセルファイルは、こちらのダウンロード釦をクリックすると、ダウンロードできます。
なお、前日比に応じて画像や音声を出力するコードも含まれております。
それらの設定については下記記事を参考にしてください。
最狂の株式・投信管理ツール誕生!! 画像と音声で楽しめる。エクセルＶＢＡで最新株価＆投信基準価額を自動取得Ver2 ｜ 富士宮で貯蓄と資産運用
やっぱ投資は愛情だよね。 株式・投資信託の価格変動に一喜一憂するのはあたりまえ。 愛する大事な銘柄たちだもの。ほったらかしになんてできない。 でも・・・数字だけじゃ感情移入しにくいし、損失が大きいと愛情も次第に冷えてきちゃうかも？ そんな貴方に愛情１本！ この管理ツールをつかえば、毎日が癒しに満たされ、どんな暴落相場が来たとしても、大好きホールドで耐えることができます。 株価取得以外に設けられてい...
ダウンロード手順
「ダウンロード」ボタンをクリックすると、ダウンロード方法を選択するウィンドゥが表示されるので、【名前を付けて保存（Ａ）】をクリックしてください。
保存する場所、ファイル名を指定するウィンドウがでます。
ファイル名の拡張子をxlsmに変更して保存してください。
保存する場所は適当で構いません。
初回起動のときに・・・
ダウンロード後、このエクセルファイルを開いたときに次のようなメッセージが表示されると思いますが、それぞれ以下のように対応してください。
【編集を有効にする（Ｅ）】をクリックしてください。
【コンテンツの有効化】をクリックしてください。
-
-
マネックス証券ワン株でFOLIOやS株Now!みたいに分散テーマ投資を行うエクセルＶＢＡツール【ＭＯＮＥＬＩＯ（マネリオ）】完成版
2018/01/20
-
エクセルで株価を自動取得するＶＢＡコードを紹介します。（日本株・米国株・投信対応版）
【現在閲覧中】
2017/10/08
-
株価・基準価額取得ソフトを高速化・米国株対応しました。
2016/01/23
-
最狂の株式・投信管理ツール誕生!! 画像と音声で楽しめる。エクセルＶＢＡで最新株価＆投信基準価額を自動取得Ver2
2015/08/10
-
株ポートフォリオが全国制覇に向けて会員増殖中！！
2014/04/11
-
