株取引に VBA を使う(シストレツール)

ホームページのトップに戻る目次

Excel VBA 目次

デイリー・トレード
 ・押し目買い(株価急落買い)
 ・株価急上昇買い
 ・ボックス圏買い(スィングトレード)
 ・配当・株主優待買い
 ・ファンドが組み込んでいる銘柄から選択する
 ・値上がりする株を買う
インターネットから株価を取得
インターネットから株価を取得2 (MSXML2.XMLHTTP を使う UNICODE)
 ・信用倍率下位の株価取得★
インターネットから株価を取得2 (MSXML2.XMLHTTP を使う ShiftJIS)
 ・日々公表銘柄の株価推移と信用残情報★
 ・指定銘柄の理論株価と対比
 ・信用売残・買残、日証金貸株・融資の増加上位の情報取得★
インターネットから株価を取得3 (createDocumentFromUrl を使う)
SMBC日興証券オンライントレード売買注文登録
標準偏差で指値の値を求める★
 ・パフォーマンス
Yahoo!ファイナンス コンセンサス予想を取得

索引


 このページは、私 渡辺真 (わたなべまこと) が、株のシステムトレードをするために作った「シストレ・ツール」を紹介するものです。
 このサイトの VBA コードは、クリエイティブ・コモンズライセンス・パターンの内、
表示-非営利-継承 表示-非営利-継承 Attribution-NonCommercial-ShareAlike」に準拠して、公開します。
「表示-非営利-継承」の条件では、無断で複製、改変、転載できます。連絡や承諾の必要はありません。


関連情報サイト
***************************

 Yahoo!ファイナンス「株式」
http://stocks.finance.yahoo.co.jp/stocks/
日経は30分遅れの株価しか見られませんが、ここは、リアルタイム株価を自動更新で参照できます。
***************************

投資主体別売買動向 (値動きが、どの主体の動きに由来しているのかが分かります)
https://www.traders.co.jp/domestic_stocks/stocks_data/investment_3/investment_3.asp
***************************

 株探(かぶたん)
本日の活況銘柄★
http://kabutan.jp/warning/?mode=2_9
本日の株価下落率ランキング
http://kabutan.jp/warning/?mode=2_2
↑この画面は優れものです。チャート・アイコンチャート・アイコンに、マウス・ポインタをもって行くと、チャートがポップアップ表示されます。
このアイコンを、[Shift]キーを押しながらマウスでクリックすると、別画面で、個別のチャートが表示されます。
個別の銘柄のチャートには、標準偏差線(ボリンジャーバンド)も表示され、売買のタイミングをつかむのに最適のサイトです。★
***************************

 本日の注意銘柄
https://search.sbisec.co.jp/v2/popwin/attention/stock/margin_M33.html
暴騰する可能性がある「日々公表」銘柄が一覧できます。
「日々公表銘柄」とは、証券取引所に上場されている銘柄のうち、信用取引による売買が過熱している銘柄について、日本証券業協会のガイドラインに従って、信用取引残高を毎日公表しているものです。
(通常の銘柄の公表は、週一回です。)
「日々公表銘柄」のデータを抽出するマクロ★も参照下さい。

信用取引に関する日々公表等
http://www.jpx.co.jp/markets/equities/margin-daily/
 お取引注意銘柄ファイル
https://www.rakuten-sec.co.jp/ITS/Companyfile/PRNT_Companyfile.html
 信用取引
http://www.traders.co.jp/margin/margin_top.asp
 空売り残高一覧(銘柄別)
http://karauri.net/4080/

 理論株価Web

 スイングトレードの達人
株価(終値)がボリンジャーバンド−2σを下抜け(25日)
http://swing-trade.net/signs_bollin2
MACDがMACDシグナルを上抜け★
http://swing-trade.net/signb_macd
***************************

 日経平均株価の推移
http://indexes.nikkei.co.jp/nkave/index/profile?cid=4&idx=nk225
https://sisannka.com/chart.html

 為替レートの推移
http://fx.yahoo.co.jp/chart/
長期も見ることができます。(豪ドルの例)
http://stocks.finance.yahoo.co.jp/stocks/chart/?code=AUDJPY=X&ct=z&t=5y&q=c&l=off&z=m&p=m65,m130&a=
***************************

 株ドラゴン
連騰 大化け 銘柄
http://www.kabudragon.com/ranking/rento.html
5日間暴騰 ランキング
http://www.kabudragon.com/ranking/5age.html

 恐るべき注目銘柄株速報
値下がり率ランキング
http://kabu-sokuhou.com/home/index/isort___down/

 株価ランキング通信
データ更新は、週1回なので、少し古い!
5日移動平均マイナス乖離率
http://kabu.money-plan.net/rank/dr05_01.htm
25日移動平均マイナス乖離率
http://kabu.money-plan.net/rank/dr25_01.htm
75日移動平均マイナス乖離率
http://kabu.money-plan.net/rank/dr75_01.htm
ストップ安
http://kabu.money-plan.net/report/s2/
***************************

 みんなの株式
データ更新は、月1回なので、かなり古い!
下落銘柄(ボリンジャーバンド)
http://minkabu.jp/screening/t_screening/result/d33854780a627811e49ab4e22e1fbb6f583a012c
***************************

 信用取引の入門講座:チェックしておきたい数字と情報
https://www.rakuten-sec.co.jp/web/domestic/margin/guide/basic7.html
 信用買い残・売り残に要注目
https://www.rakuten-sec.co.jp/web/market/opinion/adachi/adachi_20091217.html
 信用取引で、買い残が多い場合、売り残が多い場合、
それぞれの場合の株価の動きはどうなるのですか?
http://manabow.com/qa/sinyoutorihiki.html
 買い残と売り残
http://kabukiso.com/idiom/kaiurizan.html
 貸借取引とは?
http://kabukiso.com/idiom/taishakut.html
 信用残・信用倍率ってなぁに?
http://kabusyo.com/sihyo/sihyo10.html
 【図解】貸借倍率1以下銘柄投資法
http://kabu.rou5.net/fumiage.html

「信用倍率下位」の株価取得も参照下さい。

***************************

 ETFの仕組み(Exchange Traded Fund:上場投資信託)
http://www.jpx.co.jp/equities/products/etfs/etf-outline/02.html
 指標の説明(レバレッジ型指標、インバース型指標)
http://www.jpx.co.jp/equities/products/etfs/etf-outline/04.html
***************************
 

デイリー・トレード

 2013年は、前年末の政権交代を受けて、年頭から株価高騰の話題で盛り上がりました。
 また、2013年9月には、2020年のオリンピックが、東京都で開催と決まったことを受けて、多くの銘柄の株価が高騰しました。
 株の投機家にとって、2013年は、高収益の年として忘れられない年となったことでしょう。

 ここでは、Excel VBA を株取引に使うサンプルを紹介します。

 株取引とは、指定銘柄の株を、安いときに購入して、高くなったときに売って、その価格差を取得するものです。(投機:speculation)

 株価は、企業の短期・長期の損益(企業価値)を反映して上下するのが基本です。

 しかし、実際の株価は、外部要因による変動のほうが、はるかに大きく出ます。
外部要因による変動の例は、リーマンショック後の株価暴落や、日中関係の悪化を受けた中国関連株の株価下落です。

 また、内部要因でも、企業の損益に与える以上に、投資家の思惑で、株価が変動します。

 投資家の思惑で株価変動が発生するのですから、投資家がどう行動するか、を予測することが重要になります。
 株価変動の外部要因・内部要因を評価して、株価変動を予測して、株取引をすることが、利益を得るためのポイントです。
 経済学者 ケインズは、「雇用・利子および貨幣の一般理論」の第12章で、かつてイギリスの新聞紙上で行われていた「美人コンテスト」について言及している。
 この趣向は、掲載された100人の女性の顔写真の中から、読者が投票して、読者からの得票数が最も多かった6人の女性に投票した人に賞金を与えるというものだ。
 賞金をかせごうとする読者の行動は以下のようになる。
 それぞれの投票者は、自分が美人だとおもう顔ではなく、自分とまったく同じ立場に立ってだれに投票しようかと考えている自分以外の投票者の好みに一番合うとおもわれる顔に票をいれなければならない。
それは、自分が一番美人であると判断した顔を選ぶというのではなく、平均的な意見が本当に一番美人だと考えている顔を選ぶというのですらないのである。
さらに第三段階にいたると、ひとは平均的意見が平均的意見をどのように予測するかを予測するために全知全能を投入することになる。
そして、第四段階、第五段階、さらにはヨリ高次の段階の予測の予測をおこなっているひとまでいるにちがいない。

 このため、多くの投資家が参考にしているだろう、新聞(日経新聞、朝日新聞、毎日新聞、どれでも良い)の、少なくとも一紙には、朝晩必ず目を通すとよいでしょう。

 「株とアフィリエイトで1億円作ろう」の下のページに、一般的な株の売買手法が、いくつか紹介されています。
 「株の投資スタンスを確率(確立?)しよう」
http://1-okuen.com/kabu_stance.html

 デイトレード必勝テクニック
株を買う基本、株を売る基本
http://members.jcom.home.ne.jp/kai-xyz/asitamoarusa/day1.htm

 株トレード必勝のメカニズム!
トレードチャンスは3つのパターンで掴む!
http://www.excellenthorse.com/hisho/index5.html
失敗しない銘柄の選択方法とは
http://www.excellenthorse.com/hisho/index6.html

 ティックチャートとVWAPを使いこなそう @←TICK回数も重要です!
http://www.baizou-net.com/daytrade/tick-vwap1.shtml

 Speculation life
http://ryu.kakurezato.com/
システムトレードに使えるExcelテクニック集★
http://ryu.kakurezato.com/excel.html


 以下に、私が使っている手法と、具体的な事例を上げます。


押し目買い(株価急落買い)

「6674 ジーエス・ユアサ」の日足  つぶれそうもない「それなりの会社」で、何らかの不祥事が有ったときが狙い目です。
 ニュース報道を受けて株価は暴落しますが、実際の損益にはそれほど影響しないので、しばらく待てば、株価は戻ります。

 例えば右図(下のURL)は、「6674 ジーエス・ユアサ」の日足グラフです。
http://www.nikkei.com/markets/company/chart/chart.aspx?scode=6674&ba=1&type=hiasi

 株価は、下記のニュース報道を受けて、300円まで下がりました。
 2013年1月16日:ANAとJALが787型機の運航停止、緊急着陸の機体電池から電解液
 しかし、2カ月後には 400円まで戻したので、簡単に 100円(30%)の利益を上げる事ができました。

 ここで注意すべき点は、欲を出し過ぎないことです。
 2013年3月27日、三菱自動車工業が、プラグイン・ハイブリッド車に搭載するリチウムイオン電池から発熱し、電池セルと駆動用バッテリーパックの一部が溶損する事象が発生した
と発表したことを受けて、また株価が下落しました。自動車向けは飛行機向けよりボリュームがあるので、経営への影響が大きい?

 利食い(利益確定)の比率を適切(この場合は 30%) に設定しておけば、確実に利益を出すことができたでしょう。


株価急上昇買い

「1606 日本海洋掘削」の日足  「投資家の多くが買い行動をする」と予測された時に購入して、売り抜けます。
 ニュース報道を見て、早く売買できれば、勝算が高い手法です。

 例えば、右図(下のURL)は、「1606 日本海洋掘削」の日足グラフです。
http://www.nikkei.com/markets/company/chart/chart.aspx?scode=1606&ba=1&type=hiasi
この銘柄は、下記の報道を受けて、4,000円→5,000円→6,000円→7,000円と、4日間にわたって、1,000円ずつ株価が高騰しています。
 2013年03月12日:メタンハイドレートからの天然ガス生産試験に成功
http://www.itmedia.co.jp/news/articles/1303/12/news064.html
この例では、3日間のいずれかの日に買って、翌日に売れば、1,000円(20%)の利益を上げる事ができたことを意味します。

「9708 帝国ホテル」の日足  2013年は、2020年夏の東京オリンピック招致が決定した年でもあります。
2013/9/09 8:56「東京五輪決定 建設や不動産株に恩恵か 脱デフレへの期待も(日経ニュース)」となり、
2013/9/10 0:54「五輪関連株が上昇 建設軒並み、ホテルや警備も(日経ニュース)」と報道される状況になりました。

9708 帝国ホテル」(右上図)の株価は、
2013/9/06(金) の終値 3,655円に対して、
2013/9/09(月) に終値 4,355円を付けた後、
2013/9/11(水) に 6,060円の高値まで到達しました。
つまり、2013/9/10 未明の報道を見てから購入したとしても、6,000 - 4,500=1,500円(30%)の差益を得ることができたことになります。

ボックス圏買い(スィングトレード)

「6301 小松製作所」の5年間の値動き
「7012 川崎重工業」の5年間の値動き
 株価がある範囲を上がったり下がったりしている銘柄は、過去の株価から将来の株価を予想できる?と考えられます。

 例えば、右上図(下のURL)は、「6301 小松製作所」の5年間の値動きのグラフです。
http://www.nikkei.com/markets/company/chart/chart.aspx?scode=6301&ba=1&type=5year
1,500円で買って、2,500円で売る設定をしておけば、自動的(・・・)に、5年間で、1,000円(60%)×3回、収穫できたでしょう。

 右下図(下のURL)は、「7012 川崎重工業」の5年間の値動きのグラフです。
http://www.nikkei.com/markets/company/chart/chart.aspx?scode=7012&ba=1&type=5year
これも同様に、5年間で、100円(50%)×3回、収穫できた可能性が有ります。
 
 上の銘柄の波長は、1年以上で、なかなか気長に待てないですね。
 探すと、1日の間に、価格が 10% 以上乱高下する銘柄があります。
 下の図は、「3765 ガンホー・オンライン・エンターテイメント」の 1日の価格推移です。
 変動幅の下側を狙って指値して購入して、上側で販売すれば、数日の間に 10% の益を収穫できる可能性があります。
ガンホー2013年5月22日 ガンホー2013年5月23日 ガンホー2013年5月24日

配当・株主優待買い

「9202 ANAホールディングス」の日足  3月25日に株をもっている人には、株主配当、株主優待などの権利が与えられます。
 このため、配当利回りや株主優待が良い銘柄には、一時人気が出ることがあります。
 これを、先回りして買っておいて、3月25日付近で売り抜けます。

 例えば、右図(下のURL)は、「9202 ANAホールディングス」の日足のグラフです。
http://www.nikkei.com/markets/company/chart/chart.aspx?scode=9202&ba=1&type=hiasi
この年は、210円-180円で、30円(15%)のキャピタルゲイン(capital gain)を得ることができました。

 

ファンドが組み込んでいる銘柄から選択する

 ファンドは、ファンド・マネージャーが、それなりに調査して、銘柄を決めているはずです。
このため、ファンドの目論見書に記載されている銘柄を見て、その中から選択することも一方法です。

ジャパン・エクセレント★
http://www.daiwa-am.co.jp/funds/detail/detail_top.php?code=3199

 フィデリティ・日本小型株・ファンド★
https://www.fidelity.co.jp/fij/fund/funddetail.html?fundcd=217002
 フィデリティ・日本成長株・ファンド
https://www.fidelity.co.jp/fij/fund/funddetail.html?fundcd=217001

 さわかみファンド
http://www.sawakami.co.jp/fund/outline/#mokuromi

 黒田アクティブジャパン
http://www.bansei-sec.co.jp/personal/toushin/mmf-fund/kuroda_a.html

 三菱UFJ投信:優良日本株ファンド(愛称:ちから株)
http://www.am.mufg.jp/fund/250766.html

 DIAM新興企業日本株ファンド
http://www.diam.co.jp/fund/list/313331/

 日興アセットマネジメント:日本新興株オープン★
https://www.nikkoam.com/products/detail/452211/prospect


株取引に VBA を使うの目次に戻る Excel VBAの目次に戻る↑ 索引へ↓ トップページに戻る

値上がりする株を買う

 株式の発行数が少ない銘柄は、少ない資金で株価を変動させることができます。
 ヘッジファンドなどの強力な投資家の思惑で、株価が変動する銘柄を見つけて、相乗りします。

 2013年は、5月22日に、アメリカFRBのバーナンキ議長が、金融緩和の縮小について、米議会証言したことを受けて、5月23日に、株価は急落しました。
 以下のグラフは、その後の3カ月間(〜2013/08/30)の株価推移です。
 これを見ると、5月23日(下のグラフの緑色の縦線)以降、上昇した銘柄、横ばいの銘柄、下落した銘柄と、明暗を分けています。

 2014年3月20日追記:さらに半年を経過した時点で、同じ銘柄のグラフを追加しました。
当たり前のことですが、2013年8月時点での状況とはかなり景色が変わっていました。
 2013年末に日経平均株価は高値をつけましたが、それ以降、下降線をたどっています。これは、バーナンキ議長の後任の、イエレン米連邦準備制度理事会(FRB)議長が、金融緩和の縮小に加え、利上げを行う可能性を示唆したことによると言われています。

 貴方は勝ち馬に乗れましたか?

 バフェットの十八番「バリュー投資」とは?
http://diamond.jp/articles/-/4720
[PDF]知的財産の価値評価手法及び その評価事例について
http://www.harakenzo.com/jpn/seminar/data/20100115.pdf
[PDF]企業価値評価に関する一考察―カネボウ事件を手掛かりに
http://www.lec.ac.jp/graduate-school/accounting/research_activities/kiyou/data/kiyou_06/kiyou06_08.pdf
[PDF]知的財産の価値評価
http://www.tokugikon.jp/gikonshi/240tokusyu9.pdf
未公開株式の株価算定方法
http://www.business-finance-lawyers.com/knowledge/company_affairs/unreleased_share.html

2013/5〜2013/8 2013/5〜2013/8          2013/5〜2014/3  
上昇
2120:ネクスト 2120:ネクスト 2120:ネクスト
2428:ウエルネット 2428:ウエルネット 2428:ウエルネット
2497:ユナイテッド 2497:ユナイテッド 2497:ユナイテッド
3088:マツモトキヨシ 3088:マツモトキヨシ 3088:マツモトキヨシ
3782:ディー・ディー・エス 3782:ディー・ディー・エス 3782:ディー・ディー・エス
4651:サニックス 4651:サニックス 4651:サニックス
7312:タカタ 7312:タカタ 7312:タカタ
7844:マーベラス 7844:マーベラス 7844:マーベラス
2013/5〜2013/8 2013/5〜2013/8          2013/5〜2014/3  
横ばい
2337:いちごHD 2337:いちごホールディングス 2337:いちごホールディングス
2432:ディー・エヌ・エー 2432:ディー・エヌ・エー 2432:ディー・エヌ・エー
4574:大幸薬品 4574:大幸薬品 4574:大幸薬品
2013/5〜2013/8 2013/5〜2013/8          2013/5〜2014/3  
下落
3715:ドワンゴ 2715:ドワンゴ 2715:ドワンゴ
2931:ユーグレナ 2931:ユーグレナ 2931:ユーグレナ
3632:グリー 3632:グリー 3632:グリー
3765:ガンホー 3765:ガンホー 3765:ガンホー
6727:ワコム 6727:ワコム 6727:ワコム
7599:ガリバー 7599:ガリバー 7599:ガリバー
8890:レーサム 8890:レーサム 8890:レーサム
2013/5〜2013/8 2013/5〜2013/8          2013/5〜2014/3  

株取引に VBA を使うの目次に戻る Excel VBAの目次に戻る↑ 索引へ↓ トップページに戻る


インターネットから株価を取得

 デイリー・トレードといっても、注目している複数の銘柄の株価動向を日々チェックするのは面倒です。
 このため、Excel VBA で、インターネットの日経会社情報から株価を一気に取得するアプリを作りました。
 ネットの公開株価情報は、30分遅れですが、株式売買の戦略策定には、充分に威力を発揮します。

 使い方の想定は、以下の流れです。昼休みの休憩時間を利用した「デイリー・トレード」を、お楽しみ下さい。

1.出勤時に朝刊のニュースを見て、銘柄の株価動向を推理する。
2.昼休みに、既存の銘柄リストに、必要なら新しい証券コードを追加して、マクロを起動して、昼食に行く。
3.食事から帰って、取得した株価情報に基づいて、インターネットで「売り」「買い」の登録をする。


 このアプリは、取得済みの株の購入単価と、利食い・損切りの比率を登録しておくと、利食いの売りは緑色、損切りの売りは赤色で、コメントを表示します。
 また、年初来の安値に近い場合は、青色で買いのコメントを表示します。

注:利食いの比率より、損切りの比率を小さくしておくと、損失の発生を抑制できます。
価格取得のイメージ

このマクロをダウンロードできます。→StockPricesVBA02.xls
StockPricesVBA03.xls
↑バージョン03〜 MSXML2.XMLHTTP(UNICODE) を使う ように修正しました。
(したがって、下の VBA コードとは内容が異なっています。)

テスト用のデータを登録済みなので、ボタンを押すだけでマクロの動作を確認できます。
インターネットへの接続速度によりますが、数分(日経サイトで、証券コードのページを表示するまでの時間×取得したい証券コードの数)でデータ取得が完了するはずです。

 このアプリを使ったことによるいかなる損失も、私は保証しませんので、ご了解の上、ご利用下さい。

IE を操作するメインの部分は、
結城圭介さんの、Happy!Happy!Island
http://www.happy2-island.com/
の VBScript&JScript Tips
http://www.happy2-island.com/vbs/cafe02/
の 7.1 IEオブジェクトを作る(IE7編)
http://www.happy2-island.com/vbs/cafe02/capter00711.shtml
7.7 <BODY>部のHTMLを取得する
http://www.happy2-island.com/vbs/cafe02/capter00707.shtml
を、使わせていただいています。

画面が表示されるまで待ちを入れる部分は、
下記の「API 技術関連」で教えていただきました。
http://homepage1.nifty.com/MADIA/vb/VBKANREN.htm

 IEの操作方法は、IE 画面を、スクリプトで操作する の項も参照下さい。

 正規表現を使うために、参照設定を追加します。


Option Explicit
Option Base 1

   Dim データ配列() As Variant
   Dim 最終行数 As Integer
   Dim 処理行 As Integer
   Dim 対象URL As String
   Dim 日経URL As String
   Dim IEバージョン As String
   Dim IEオブジェクト As Object
   Dim 入力行 As Integer
   Dim 処理 As String
   Dim Shellオブジェクト As Object
   Dim 前回最終行 As Integer
   Dim HTMLソース As String
   Dim HTMLタイトル As String
   Dim 開始時刻 As Variant
   Dim 終了時刻 As Variant


Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
'これで Sleepを使ってミリ秒単位で処理にウェイトを入れることができます。


Sub 日経会社情報で株価を取得する()

   開始時刻 = Now() 'マクロの処理時間を計測するため、開始時刻を取得

   ThisWorkbook.Worksheets("スタート").Activate

   'シート「スタート」の登録内容を、証券コード順に並び替え
   Range("A1").CurrentRegion.Sort _
      Key1:=Range("A1"), Order1:=xlAscending, _
      Header:=xlYes

   Call IEバージョンを調べる() 'IEのバージョンによって処理が変わるため

   'インターネット画面表示するためのデータを格納
   データ配列 = Range("A1").CurrentRegion.Value
   最終行数 = UBound(データ配列)
   日経URL = Range("G11").Value

   ThisWorkbook.Worksheets("取得株価").Activate
   前回最終行 = Cells(ActiveSheet.Rows.Count, 1).End(xlUp).Row

   '前回取得時の内容を削除
   If 前回最終行 > 1 Then
      Rows("2:" & CStr(前回最終行)).Delete Shift:=xlUp
   End If

   '証券コード毎に、インターネットから情報を取得
   For 処理行 = 2 To 最終行数

      'Shell.Applicationオブジェクトの作成
      Set Shellオブジェクト = CreateObject("Shell.Application")
      'IEオブジェクトの作成(ダミー)
      Set IEオブジェクト = CreateObject("InternetExplorer.Application")
      対象URL = 日経URL & データ配列(処理行, 1)

      If IEバージョン > "6" Then
         IEオブジェクト.Navigate2 対象URL     '★IE7の場合、既存or新しいウィンドウで表示される
         If 入力行 = 1 Then
            IEオブジェクト.Quit               '★IE7の場合、ここで閉じるのはCreateObjectで作成したウィンドウ
            Set IEオブジェクト = Nothing      '★IE7の場合、いったんオブジェクトをクリア
            Application.Wait Now + TimeValue("00:00:01")
         End If

         処理 = "Shell.ApplicationオブジェクトのWindowオブジェクトからIEオブジェクトを取り出す"
         '作成されているポイントは、Windowsコレクションの最後の要素

         Set IEオブジェクト = Shellオブジェクト.Windows.Item(Shellオブジェクト.Windows.Count - 1)
         'これ以降は、従来と同様の方法で操作が可能
         With IEオブジェクト
            .Navigate 対象URL
            .Visible = True
         End With

         Call IE表示待ち

      Else
         '★IE6以前の場合
         Set IEオブジェクト = CreateObject("InternetExplorer.Application")

         With IEオブジェクト
            .Navigate 対象URL
            .Visible = True
         End With

         Call IE表示待ち

      End If

      HTMLタイトル = ""
      HTMLソース = ""

      Do While HTMLソース = ""
         Sleep (1000)
         HTMLソース = IEオブジェクト.Document.Body.InnerHtml
      Loop

      HTMLタイトル = IEオブジェクト.LocationName

      Call 株価を取得してシートに貼付け 'ブラウザの画面から必要な項目を抽出して貼付けする

      IEオブジェクト.Quit

   Next 処理行

   'オブジェクトを破棄
   Set IEオブジェクト = Nothing

   'マクロの処理時間を表示して、マクロの終了を伝える
   終了時刻 = Now()
   MsgBox "処理が終了しました。" & Chr(13) _
   & "処理時間は、" & Format(終了時刻 - 開始時刻, "nn分ss秒") & " でした。", vbOKOnly

End Sub


Private Sub 株価を取得してシートに貼付け()
   Dim 文字配列
   Dim ページ行数 As Integer
   Dim 行文字列 As String
   Dim 行数 As Integer
   Dim 行カウンタ As Integer

   If Left(HTMLタイトル, 2) = "()" Then '証券コードのデータが存在しない場合
      Range("A1").Cells(処理行, 1).Value = データ配列(処理行, 1)
      Range("B1").Cells(処理行, 1).Value = "★証券コードの企業が存在しません★"

   Else '証券コードのデータが存在した場合
      Range("A1").Cells(処理行, 1).Value = データ配列(処理行, 1)
      Range("B1").Cells(処理行, 1).Value = Trim(Mid(HTMLタイトル, 5, InStr(HTMLタイトル, ":") - 5))

      'ブラウザに表示されている内容を、1行ずつに分割
      文字配列 = Split(HTMLソース, vbNewLine)

      '全体行数を取得
      ページ行数 = UBound(文字配列)

      '取得行の絞込みに使うパラメータを初期化
      行カウンタ = 1

      '1行目から順に、最後の行まで
      For 行数 = 200 To ページ行数
         行文字列 = 文字配列(行数)

         'HTML から必要な項目を抽出するためのコーディングの情報を取得
         Debug.Print 行数
         Debug.Print 行文字列 'HTMLの内容を、イミディエイト・ウインドウに表示する

         If 行カウンタ = 1 Then
            If InStr(行文字列, "全上場企業データベース") = 0 Then
               GoTo 次の行へ '「全上場企業データベース」の行に到達するまで読み飛ばす
            Else
               行カウンタ = 行数
            End If
         End If

         If InStr(行文字列, "DD class=stc-now") > 0 And 行数 > 行カウンタ Then   '現在値
            行カウンタ = 行数
            Range("C1").Cells(処理行, 1).Value = Trim(正規表現で置換("<(.*?)>", 行文字列, ""))

         ElseIf (InStr(行文字列, "SPAN class=cmn-plus") > 0 Or InStr(行文字列, "SPAN class=cmn-minus") > 0 _
            Or InStr(行文字列, "SPAN class=stc-percent") > 0) _
            And 行数 > 行カウンタ Then    '前日比金額 前日比%

            行カウンタ = 行数
            Range("H1").Cells(処理行, 1).Value _
            = Left(正規表現で置換("<(.*?)>", 行文字列, ""), InStr(正規表現で置換("<(.*?)>", 行文字列, ""), "(") - 1)
            Range("I1").Cells(処理行, 1).Value _
            = Mid(Trim(正規表現で置換("<(.*?)>", 行文字列, "")) _
            , InStr(Trim(正規表現で置換("<(.*?)>", 行文字列, "")), "(") + 1 _
            , Len(Trim(正規表現で置換("<(.*?)>", 行文字列, ""))) - InStr(Trim(正規表現で置換("<(.*?)>", 行文字列, "")), "(") - 1)

         ElseIf InStr(行文字列, "DD class=stc-opening") > 0 And 行数 > 行カウンタ Then     '始値
            行カウンタ = 行数
            Range("J1").Cells(処理行, 1).Value = Trim(正規表現で置換("<(.*?)>", 行文字列, ""))

         ElseIf InStr(行文字列, "DD class=stc-high") > 0 And 行数 > 行カウンタ Then      '高値
            行カウンタ = 行数
            Range("K1").Cells(処理行, 1).Value = Trim(正規表現で置換("<(.*?)>", 行文字列, ""))

         ElseIf InStr(行文字列, "DD class=stc-low") > 0 And 行数 > 行カウンタ Then    '安値
            行カウンタ = 行数
            Range("L1").Cells(処理行, 1).Value = Trim(正規表現で置換("<(.*?)>", 行文字列, ""))

         ElseIf InStr(行文字列, "DD class=stc-sales") > 0 And 行数 > 行カウンタ Then        '売買高
            行カウンタ = 行数
            Range("M1").Cells(処理行, 1).Value = Trim(正規表現で置換("<(.*?)>", 行文字列, ""))

         ElseIf InStr(行文字列, "DD class=stc-pbr") > 0 And 行数 > 行カウンタ Then        'PBR (実績)
            行カウンタ = 行数
            Range("N1").Cells(処理行, 1).Value = Trim(正規表現で置換("<(.*?)>", 行文字列, ""))

         ElseIf InStr(行文字列, "DD class=stc-per") > 0 And 行数 > 行カウンタ Then        'PER (予想)
            行カウンタ = 行数
            Range("O1").Cells(処理行, 1).Value = Trim(正規表現で置換("<(.*?)>", 行文字列, ""))

         ElseIf InStr(行文字列, "cmnc-middle") > 0 And 行数 > 行カウンタ Then        '関連ニュース
            行カウンタ = 行数
            Range("E1").Cells(処理行, 1).Value = Trim(正規表現で置換("<(.*?)>", 行文字列, ""))

         ElseIf InStr(行文字列, "年初来高値") > 0 And 行数 > 行カウンタ Then        '年初来高値
            行カウンタ = 行数
            行数 = 行数 + 1
            行文字列 = 文字配列(行数)
            Debug.Print 行数
            Debug.Print 行文字列
            Range("P1").Cells(処理行, 1).Value = Trim(正規表現で置換("<(.*?)>", 行文字列, ""))

         ElseIf InStr(行文字列, "年初来安値") > 0 And 行数 > 行カウンタ Then        '年初来安値
            行カウンタ = 行数
            行数 = 行数 + 1
            行文字列 = 文字配列(行数)
            Debug.Print 行数
            Debug.Print 行文字列
            Range("Q1").Cells(処理行, 1).Value = Trim(正規表現で置換("<(.*?)>", 行文字列, ""))

         ElseIf InStr(行文字列, "10年来高値") > 0 And 行数 > 行カウンタ Then     '10年来高値
            行カウンタ = 行数
            行数 = 行数 + 1
            行文字列 = 文字配列(行数)
            Debug.Print 行数
            Debug.Print 行文字列

            Range("R1").Cells(処理行, 1).Value = Trim(正規表現で置換("<(.*?)>", 行文字列, ""))

         ElseIf InStr(行文字列, "10年来安値") > 0 And 行数 > 行カウンタ Then     '10年来安値

            行数 = 行数 + 1
            行文字列 = 文字配列(行数)
            Debug.Print 行数
            Debug.Print 行文字列

            Range("S1").Cells(処理行, 1).Value = Trim(正規表現で置換("<(.*?)>", 行文字列, ""))
            Exit For
         End If
次の行へ:
      Next 行数 'html の Body データを一行ごとに読む


      'コメント部分を表示
      If データ配列(処理行, 2) <> "" Then '保有株
         Range("F1").Cells(処理行, 1).Value = データ配列(処理行, 2) '購入単価
         Range("G1").Cells(処理行, 1).Value = _
         Range("C1").Cells(処理行, 1).Value / Range("F1").Cells(処理行, 1).Value * 100 - 100

         If データ配列(処理行, 3) <> "" Then '利食い率
            If Range("C1").Cells(処理行, 1).Value > Range("F1").Cells(処理行, 1).Value * (1 + データ配列(処理行, 3) / 100) Then
               Range("D1").Cells(処理行, 1).Value = "売り"
               Range("D1").Cells(処理行, 1).Interior.ColorIndex = 4
            End If
         End If

         If データ配列(処理行, 4) <> "" Then '損切り率
            If Range("C1").Cells(処理行, 1).Value < Range("F1").Cells(処理行, 1).Value * (1 - データ配列(処理行, 4) / 100) Then
               Range("D1").Cells(処理行, 1).Value = "売り"
               Range("D1").Cells(処理行, 1).Interior.ColorIndex = 3
            End If
         End If

      End If
      '年初来安値との比較
      If Range("C1").Cells(処理行, 1).Value < Val(Range("Q1").Cells(処理行, 1).Value) * 1.05 Then
         Range("D1").Cells(処理行, 1).Value = "買い"
         Range("D1").Cells(処理行, 1).Interior.ColorIndex = 8
      End If
      '前日比マイナスを赤に
      If Val(Range("I1").Cells(処理行, 1).Value) < -0.01 Then
         Range("I1").Cells(処理行, 1).Interior.ColorIndex = 7
      End If
   End If

End Sub


Private Sub IE表示待ち()

   DoEvents       ' Sleep しているときに、画面を書き換えできるように、OS に制御を渡す。

   Do While IEオブジェクト.Busy = True Or IEオブジェクト.readystate <> 4
      Sleep (1000)
   Loop
   Sleep (2000)

End Sub


株取引に VBA を使うの目次に戻る Excel VBAの目次に戻る↑ 索引へ↓ トップページに戻る


インターネットから株価を取得2 (MSXML2.XMLHTTP を使う UNICODE)

 このサイトでは、Web のデータを取得するために、インターネット・エクスプローラ(IE)の画面を使っています。このため、IE のページを開く時間が、少なからずかかっていました。

 それが、下記のサイトで、yutaro さんが、MSXML2.XMLHTTP を使う方法を、公開していただいているのを見つけました。
 システムトレーダーの冒険の書
http://yutarosnotebook.blog.fc2.com/
 時系列株価を取得できるVBScriptプログラム
http://yutarosnotebook.blog.fc2.com/blog-entry-104.html

 下記は、VBScript の形でソース公開していただいているものを VBA に書き直したものです。
IE を開かないで HTMLソースを取得できるので、処理を高速化できました。

このマクロをダウンロードできます。→GetTimeSeriesStockPricesVBA03.xls

 注意:「Microsoft XML, v3.0」(v3.0以上)を参照設定する必要があります。
「Microsoft XML. v6.0」だと、Windows 8.1では「コンパイルエラー: ユーザー定義型は定義されていません」とエラーになるそうです。
 MSXML2.XMLHTTP を使って Web のデータを取得する場合、サイトのソースが ShiftJIS の場合 と UNICODE(utf-8) の場合とで、VBAのコードが少し変わります。
 このマクロは、HTMLソースが UNICODE の場合の事例です。

 追記1:
 MSXML2.XMLHTTP を使って、HTMLソースを取得も参照下さい。
 追記2:
 HTMLDocument.createDocumentFromUrl でも、IE を使わずにHTMLソースを取得できます。
 処理時間は、MSXML2.XMLHTTP を使う場合と比較して、5倍もかかって遅いのですが、何かの役に立つこともあるかもしれないので、「インターネットから株価を取得3 (createDocumentFromUrl を使う)」として掲示しておきます。

 参考サイト:
 XMLHttpRequestオブジェクトのメソッドとプロパティ
http://www.ajaxtower.jp/ini/http/index2.html
 [VBA]Excel VBAでHTTP通信
http://outofmem.hatenablog.com/entry/2013/10/04/115600
 MSXML2.XMLHTTPでvbaからweb apiを利用
http://d.hatena.ne.jp/end0tknr/20081115/1226755041
 VBAでHTTPリクエスト
http://www.k-sugi.sakura.ne.jp/windows/vb/3687/
 非同期通信(XMLHttpRequestの使い方)
http://phpjavascriptroom.com/?t=ajax&p=xmlhttp
 サーバから非同期にレスポンスを受け取る方法 (Ajax)
http://so-zou.jp/web-app/tech/programming/javascript/ajax/
 Ajax でサーバー通信
http://webapli.fam.cx/script/jsphtml/page/jsp41_ajax.html
 今からでも遅くない Ajax基本のキ
http://itpro.nikkeibp.co.jp/article/COLUMN/20060530/239467/
 Microsoft の XMLHTTP オブジェクトを使用して他の Web ページのデータを取得する
http://internetcom.jp/developer/20051005/28.html
 Web ページをダウンロードする方法〜 MSXML 編〜
http://www.f3.dion.ne.jp/~element/msaccess/AcTipsVbaXMLHTTP.html

Option Explicit
Option Base 1

   Dim XMLHTTPオブジェクト As Object
   Dim URL株式株価Yahooファイナンス As String


Sub 時系列株価を取得()

   Dim HTMLタイトル As String
   Dim 正規表現タイトル As RegExp
   Dim Matchesコレクション As Object

   Dim 銘柄コード As String
   Dim SaveFolder As String
   Dim 取得ページ数 As Integer
   Dim ファイルシステムオブジェクト As Object
   Dim 出力ファイルパス As String
   Dim キストストリームオブジェクト As Object
   Dim 正規表現 As RegExp
   Dim 取得ページカウンタ As Integer
   Dim HTMLソース As String
   Dim SubMatchesコレクション As Object
   Dim カウンタ As Integer
   Dim 開始日時 As Variant
   Dim 終了日時 As Variant
   Dim 追加シート名初期 As String
   Dim 追加シート名 As String
   Dim 重複 As Integer
   Dim シート As Worksheet
   Dim シート数 As Integer

   Dim 列数 As Integer
   Dim 行数 As Integer
   Dim 文字列 As String
   Dim 銘柄配列() As Variant
   Dim 最終行 As Integer
   Dim 銘柄数 As Integer
   Dim 銘柄カウンタ As Integer

   '時系列株価を取得し、Excelシートに書き出すツールです。

   開始日時 = Now                ' 開始時刻を変数に格納します。
   
   ' 処理を高速化するため、自動計算停止
   Application.Calculation = xlCalculationManual

   '前回作成したシートがあれば削除
   For Each シート In ThisWorkbook.Worksheets
      If シート.Name <> "テンプレート" And シート.Name <> "指定登録" Then
         'シート名 テンプレート と 指定登録 以外のシートを削除
         Application.DisplayAlerts = False
         シート.Delete
         Application.DisplayAlerts = True
      End If
   Next シート
   
   ThisWorkbook.Worksheets("指定登録").Activate
   URL株式株価Yahooファイナンス = Range("B1").Value
   取得ページ数 = Int(Range("B2").Value / 20 + 0.99)
   最終行 = Cells(ActiveSheet.Rows.Count, 1).End(xlUp).Row
   銘柄数 = 最終行 - 5
   銘柄配列 = Range("A6").Resize(銘柄数, 1)
   SaveFolder = Range("B3").Value

   '以上が設定です。ここより下の行はメインプログラムとなります。
   
   Set ファイルシステムオブジェクト = CreateObject("Scripting.FileSystemObject")
   
   If Dir(ソース保存フォルダ, vbDirectory) = "" Then 'この名前のフォルダが存在しなければ
      MkDir ソース保存フォルダ
   End If


   Set 正規表現 = New RegExp
   正規表現.Pattern = "(\d{4}年\d{1,2}月\d{1,2}日)</td><td>([\.0-9|,]+)</td><td>([\.0-9|,]+)</td><td>([\.0-9|,]+)</td><td>([\.0-9|,]+)</td><td>([\.0-9|,]+)</td><td>([\.0-9|,]+)"
   正規表現.Global = True

   'HTML のタイトル抽出用
   Set 正規表現タイトル = New RegExp
   With 正規表現タイトル
      .Pattern = "<title>.*</title>"
      .IgnoreCase = True '大文字小文字を区分しない
      .Global = False
   End With

   For 銘柄カウンタ = 1 To 銘柄数
   
      '株価コードを設定します
      銘柄コード = 銘柄配列(銘柄カウンタ, 1)
   
      出力ファイルパス = ファイルシステムオブジェクト.buildPath(SaveFolder, 銘柄コード & ".txt")
      '構文:object.CreateTextFile(filename[, overwrite[, unicode]]) → ShiftJIS だとエラーになる文字があるため↓
      'http://blog.systemjp.net/entry/2013/04/10/191821 ←教えていただいたサイト
      'http://ameblo.jp/cashtray/entry-11066671774.html ←教えていただいたサイト
      Set キストストリームオブジェクト = ファイルシステムオブジェクト.CreateTextFile(出力ファイルパス, True, True)

      追加シート名初期 = 銘柄コード
      追加シート名 = 追加シート名初期
   
      For 重複 = 1 To 100
      ' 100枚まで追加しても重複しないように追番を設定します。
          For Each シート In Worksheets
              If シート.Name = 追加シート名 Then
                  追加シート名 = 追加シート名初期 & "(" & 重複 & ")"
              End If
          Next シート
      Next 重複
      シート数 = Worksheets.Count
      Worksheets("テンプレート").Copy After:=Worksheets(シート数)
      ActiveSheet.Name = 追加シート名
      
      行数 = 0
      For 取得ページカウンタ = 1 To 取得ページ数
         HTMLソース = HTML取得(URL結合(銘柄コード, Date - 80 * 取得ページカウンタ, Date, 取得ページカウンタ))
          
         Range("A2").Value = URL結合(銘柄コード, Date - 80 * 取得ページカウンタ, Date, 取得ページカウンタ)


         '検証用にHTMLソースを出力
         キストストリームオブジェクト.writeLine HTMLソース

         'HTML のタイトル抽出
         Set Matchesコレクション = 正規表現タイトル.Execute(HTMLソース)
         文字列 = Matchesコレクション.Item(0).Value
         HTMLタイトル = Trim(正規表現で置換("<(.*?)>", 文字列, ""))
            
         If InStr(HTMLタイトル, ":") > 0 Then
            Range("A1").Value = Trim(Left(HTMLタイトル, InStr(HTMLタイトル, ":") - 1))
         Else
            Range("A1").Value = HTMLタイトル
         End If

         '1行目から順に、最後の行まで
      
         Set SubMatchesコレクション = 正規表現.Execute(HTMLソース)
         For カウンタ = 0 To SubMatchesコレクション.Count - 1
            行数 = 行数 + 1
            For 列数 = 1 To 7
               Range("A4").Cells(行数, 列数).Value = SubMatchesコレクション.Item(カウンタ).SubMatches(列数 - 1)
            Next 列数
         Next カウンタ

      Next 取得ページカウンタ
      
      キストストリームオブジェクト.Close
   
   Next 銘柄カウンタ
   
   ' 自動計算停止解除
   Application.Calculation = xlCalculationAutomatic
    
   終了日時 = Now
   MsgBox "処理時間は、" _
   & Format(終了日時 - 開始日時, "hh時間nn分ss秒") & " でした。"

End Sub


Function URL結合(code, s_date, e_date, p_cnt)
'時系列データ取得元サイトのURLを作成する関数
    URL結合 = URL株式株価Yahooファイナンス
    URL結合 = URL結合 & "?code=" & code & ".T"
    URL結合 = URL結合 & "&sy=" & Year(s_date)
    URL結合 = URL結合 & "&sm=" & Month(s_date)
    URL結合 = URL結合 & "&sd=" & Day(s_date)
    URL結合 = URL結合 & "&ey=" & Year(e_date)
    URL結合 = URL結合 & "&em=" & Month(e_date)
    URL結合 = URL結合 & "&ed=" & Day(e_date)
    URL結合 = URL結合 & "&tm=d"
    URL結合 = URL結合 & "&p=" & p_cnt
    
End Function


Function HTML取得(url)
'URLからHTMLを取得する関数
   Set XMLHTTPオブジェクト = CreateObject("MSXML2.XMLHTTP")
'    On Error Resume Next
   Call XMLHTTPオブジェクト.Open("GET", url, False)
   Call XMLHTTPオブジェクト.send

   'http://www.ajaxtower.jp/ini/http/index2.html
   '「open」メソッドはサーバに対するHTTPリクエストを作成します。
   '1 番目の引数は、リクエストが「GET」か「POST」かを指定します。(必須)
   '2 番目の引数は、リクエストを送るURLを指定します。 (必須)
   '3 番目の引数は、非同期通信か同期通信かを指定します。
   ' 同期通信の場合は「false」を、非同期通信の場合は「true」を指定します。省略した場合は「true」が設定されます。
   ' 同期通信にした場合はサーバに対するリクエストからの応答があるまで待ってから次の処理へ進みます。
   ' その為、処理が移った時点では既に応答が帰ってきていますので、その応答に対する処理を記述するだけで記述は簡単になります。
   ' その代わり応答が帰ってくるまでブラウザは他の処理を行えません。
   ' 非同期通信にした場合にはリクエストを送った時点で次の処理へ進みます。
   ' その為、リクエストを送信したブラウザではすぐに他の処理を行えますが、
   ' 今度は応答に対する処理を行うには、応答が帰ってきたのかどうかを別途調べる処理が必要となります。

   HTML取得 = XMLHTTPオブジェクト.responseText

'    On Error GoTo 0
End Function


 解説:
 SubMatches コレクションとは、正規表現のサブマッチ文字列のコレクションです。
サブマッチとは、1つの検索パターンの中に複数の検索条件が含まれているとき、個々の条件とマッチした部分のことを意味します。
SubMatches コレクションには、個別のサブマッチ文字列が格納されます。
このコレクションは、RegExp オブジェクトの Execute メソッドによってのみ作成可能です。
SubMatches コレクションのプロパティは、すべて読み取り専用です。
正規表現で検索を実行すると、サブ条件が取得を示すかっこで囲まれている場合にサブマッチ文字列が 0 個以上作成されます。
SubMatches コレクションの各項目は、正規表現によって検索および取得される文字列です。


 open メソッド には、リンク先URL、メソッド、および未完了の要求の他の任意属性を割り当てます。

構文:オブジェクト名.open( HTTPメソッド, リクエスト先URL[, 非同期の有無[, ユーザー名[, パスワード]]] )

オプションの第3引数の「非同期の有無」は、true を指定すると非同期(データの送受信の終了を待たずに次ぎの処理に移る)に、false を指定すると同期(完全にデータを取得するまで処理を待つ)になります。
省略した場合は、デフォルトの true(非同期)が適用されます。

オプションの第4引数の「ユーザー名」を指定すると、認証ページで認証ダイアログが表示されます。
パスワードは、オプションの第5引数の「パスワード」に指定します。


株取引に VBA を使うの目次に戻る Excel VBAの目次に戻る↑ 索引へ↓ トップページに戻る


「信用倍率下位」の株価取得

 このマクロを使うと、信用倍率下位で売残と買残の差の大きい銘柄とその株価推移を知ることができます。

1.マクロの機能
 (1).ヤフーファイナンス株式ランキング の「信用倍率下位」から、「B2」セルで指定した売残と買残の差に対応した銘柄コードを取得します。
 (2).Yahoo!ファイナンス 株式/株価 から該当コードの過去80日間の株価データを取得してシートに書き出します。
 (3).株探 Kabutan から、該当コードの信用残の時系列データを追記します。
 (4).karauri.net から、機関の空売り残高情報を追記します。

2.使い方
「開始」ボタンを押すだけ。

3.補足
前回処理で、銘柄コードや株価データ・シートが残っていても、マクロの処理の中で削除します。
このため、このブックを開いて、「指定登録」のシートで「開始」ボタンを押すだけで、最新の対象銘柄と、その株価データを取得できます。

このマクロをダウンロードできます。→LowerRankCreditMagnificationVBA01.xls


株取引に VBA を使うの目次に戻る Excel VBAの目次に戻る↑ 索引へ↓ トップページに戻る


インターネットから株価を取得2 (MSXML2.XMLHTTP を使う ShiftJIS)

 MSXML2.XMLHTTP を使って Web のデータを取得する場合、サイトのソースが UNICODE(utf-8) の場合と ShiftJIS の場合とで、VBAのコードが少し変わります。

 Web ページをダウンロードする方法〜 MSXML 編〜
http://www.f3.dion.ne.jp/~element/msaccess/AcTipsVbaXMLHTTP.html
 ホームページデータを取得する/サイトが有効か確認する
http://www.kanaya440.com/contents/tips/vbs/007.html

 ここで紹介するマクロは、HTMLソースが ShiftJIS の場合の事例です。


株取引に VBA を使うの目次に戻る Excel VBAの目次に戻る↑ 索引へ↓ トップページに戻る

日々公表銘柄の株価推移と信用残情報

 このマクロを使うと、指定された後しばらくの間は、まだ暴騰する可能性がある「日々公表銘柄」とその株価推移を知ることができます。

1.マクロの機能
 (1).SBI証券の「本日の注意銘柄」のWEBデータ から「日々公表」の銘柄コードを取得します。
 (2).Yahoo!ファイナンス 株式/株価 から該当コードの過去80日間の株価データを取得してシートに書き出します。
 (3).株探 Kabutan から、該当コードの信用残の時系列データを追記します。
 (4).karauri.net から、機関の空売り残高情報を追記します。

「日々公表銘柄」とは、証券取引所に上場されている銘柄のうち、信用取引による売買が過熱している銘柄について、日本証券業協会のガイドラインに従って、信用取引残高を毎日公表しているものです。
(通常の銘柄の公表は、週一回です。)

日々公表銘柄に指定され暴騰する場合

【買い残が多い時】
今まで買い仕掛けたディーラー、機関投資家は踏み上げはないと判断して、利食いをするため、値段は下がります。
【売り残が多い時】
買いを仕掛けたディーラー、機関投資家は安心して売り方が損きりの処分をするまで、買いを入れます。
売り方は損きりの買いを入れざる得なくなり、値段は上がります。

貸借倍率(信用取り組み倍率)1以下の銘柄は、株価が上がる期待が大きな銘柄
信用取組みで見る株価の思惑
日本証券金融株式会社 融資貸株残高詳細情報
http://www.jsf.co.jp/de/stock/data.php?target=balance&div=%93%8C%8F%D8&code=7608

 例:(株)エスケイジャパン【7608】東証 指定日:2015/9/3
日付始値高値安値終値出来高調整後終値*上昇下落率
2015年9月11日518.0 518.0 518.0 518.0 279,100518.0 18.26%
2015年9月10日472.0 472.0 420.0 438.0 7,152,900438.0 11.73%
2015年9月 9日344.0 392.0 340.0 392.0 4,782,900392.0 25.64%
2015年9月 8日366.0 405.0 307.0 312.0 12,213,900312.0 -4.29%
2015年9月 7日312.0 336.0 298.0 326.0 23,254,900326.0 13.19%
2015年9月 4日272.0 315.0 266.0 288.0 6,894,200288.0  4.35%
2015年9月 3日266.0 280.0 262.0 276.0 2,697,600276.0  2.60%
2015年9月 2日211.0 298.0 210.0 269.0 6,258,200269.0 23.39%
2015年9月 1日219.0 219.0 217.0 218.0 2,500218.0 -1.80%

2.使い方
「開始」ボタンを押すだけ。

3.補足
前回処理で、銘柄コードや株価データ・シートが残っていても、マクロの処理の中で削除します。
このため、このブックを開いて、「指定登録」のシートで「開始」ボタンを押すだけで、最新の対象銘柄と、その株価データを取得できます。

このマクロをダウンロードできます。→DailyPublicationStocksVBA09.xls

Option Explicit
Option Base 1

'01:2015/09/03:作成
'02:2015/09/10:指定日が一週間以内の場合、セル背景色を赤に。2週間以内の場合は黄色に。
'03:2015/09/12:銘柄シートへのリンク追加。

   Dim XMLHTTPオブジェクト As Object
   Dim URL株式株価Yahooファイナンス As String
   Dim 文字列 As String

Sub 日々公表銘柄の時系列株価を取得()

   Dim 開始日時 As Variant
   Dim 終了日時 As Variant
   
   開始日時 = Now                ' 開始時刻を変数に格納します。
   
   ' 処理を高速化するため、自動計算停止
   Application.Calculation = xlCalculationManual
   
   Call SBI証券の注意銘柄から日々公表銘柄を取得
   Call 時系列株価を取得
   
   ThisWorkbook.Worksheets("指定登録").Activate
   
   ' 自動計算停止解除
   Application.Calculation = xlCalculationAutomatic
    
   終了日時 = Now
   MsgBox "処理時間は、" _
   & Format(終了日時 - 開始日時, "hh時間nn分ss秒") & " でした。"
   
End Sub


Private Sub SBI証券の注意銘柄から日々公表銘柄を取得()

   Dim URL注意銘柄 As String
   Dim SubMatchesコレクション As Object
   Dim ファイルシステムオブジェクト As Object
   Dim 出力ファイルパス As String
   Dim キストストリームオブジェクト As Object
   Dim ソース保存フォルダ As String
   Dim 正規表現 As RegExp
   Dim HTMLソース As String
   Dim カウンタ As Integer
   Dim 最終行 As Integer
   Dim 日付 As Date
   Dim 銘柄コード As String
   Dim 銘柄名 As String
   
   ThisWorkbook.Worksheets("指定登録").Activate
   URL注意銘柄 = Range("B4").Value
   ソース保存フォルダ = Range("B3").Value
   
   '前回の取得銘柄のデータを削除
   最終行 = Cells(ActiveSheet.Rows.Count, 1).End(xlUp).Row
   Range("A6:C" & CStr(最終行)).Delete Shift:=xlUp
   
   Set ファイルシステムオブジェクト = CreateObject("Scripting.FileSystemObject")
   
   If Dir(ソース保存フォルダ, vbDirectory) = "" Then 'この名前のフォルダが存在しなければ
      MkDir ソース保存フォルダ
   End If
   
   Set 正規表現 = New RegExp
   
   '<td class="mtext">(.+?)</td><td align="center" class="mtext">([0-9]{4})</td><td class="mtext">東証</td><td class="mtext">日々公表((.+?))</td>
   'VBAコードの文字定数(引用符「"」で囲まれた文字列)の中に引用符を入れたいときは、「"」を 2重にします。
   正規表現.Pattern = "<td class=""mtext"">(.+?)</td><td align=""center"" class=""mtext"">([0-9]{4})</td><td class=""mtext"">東証</td><td class=""mtext"">日々公表((.+?))</td>"
   
   正規表現.Global = True
   
   出力ファイルパス = ファイルシステムオブジェクト.buildPath(ソース保存フォルダ, "注意銘柄.txt")
   '構文:object.CreateTextFile(filename[, overwrite[, unicode]]) → ShiftJIS だとエラーになる文字があるため↓
   'http://blog.systemjp.net/entry/2013/04/10/191821 ←教えていただいたサイト
   'http://ameblo.jp/cashtray/entry-11066671774.html ←教えていただいたサイト
   Set キストストリームオブジェクト = ファイルシステムオブジェクト.CreateTextFile(出力ファイルパス, True, True)
   
   'WEB ページが Shift_JIS のためUNICODEに変換して取得
   HTMLソース = HTML取得ShiftJIS2UNICODE(URL注意銘柄)
   
   '正規表現でマッチングするために過剰な改行を外す。
   HTMLソース = Replace(HTMLソース, vbNewLine, "") 'Windowsのサーバ用
   HTMLソース = Replace(HTMLソース, vbLf, "")      'UNIXのサーバ用
   
   '表の行単位にするために、表の行末に改行を挿入
   HTMLソース = Replace(HTMLソース, "</tr>", "</tr>" & vbNewLine)
   '見やすくするために、</head>の後に改行を入れる
   HTMLソース = Replace(HTMLソース, "</head>", "</head>" & vbNewLine)
   
   '検証用にHTMLソースを出力
   キストストリームオブジェクト.writeLine HTMLソース
   
   Set SubMatchesコレクション = 正規表現.Execute(HTMLソース)
   
   '1つめのマッチから順に、最後のマッチまで
   For カウンタ = 0 To SubMatchesコレクション.Count - 1
   
      銘柄コード = SubMatchesコレクション.Item(カウンタ).SubMatches(1)
      ActiveSheet.Hyperlinks.Add Anchor:=Range("A6").Cells(カウンタ + 1, 1), Address:="", _
      SubAddress:="'" & 銘柄コード & "'!A1", TextToDisplay:=銘柄コード
      
      銘柄名 = SubMatchesコレクション.Item(カウンタ).SubMatches(0)
      ActiveSheet.Hyperlinks.Add Anchor:=Range("B6").Cells(カウンタ + 1, 1), Address:="", _
      SubAddress:="'" & 銘柄コード & "'!A1", TextToDisplay:=銘柄名
      
      Range("C6").Cells(カウンタ + 1, 1).Value = SubMatchesコレクション.Item(カウンタ).SubMatches(2) & Space(1) & SubMatchesコレクション.Item(カウンタ).SubMatches(3)
      
      '指定日の日付部分を抽出
      文字列 = Range("C6").Cells(カウンタ + 1, 1).Value
      If InStr(文字列, ")") > 1 Then
         文字列 = Left(文字列, InStr(文字列, ")") - 1)
      ElseIf InStr(文字列, ")") > 1 Then
         文字列 = Left(文字列, InStr(文字列, ")") - 1)
      End If
      
      '最近の指定分を色分け
      日付 = 正規表現で置換("[^/0-9]", 文字列, "")

      If DateDiff("d", 日付, Date) < 7 Then
         Range("A6").Cells(カウンタ + 1, 1).Interior.ColorIndex = 7
         Range("B6").Cells(カウンタ + 1, 1).Interior.ColorIndex = 7
         Range("C6").Cells(カウンタ + 1, 1).Interior.ColorIndex = 7
      ElseIf DateDiff("d", 日付, Date) < 14 Then
         Range("A6").Cells(カウンタ + 1, 1).Interior.ColorIndex = 6
         Range("B6").Cells(カウンタ + 1, 1).Interior.ColorIndex = 6
         Range("C6").Cells(カウンタ + 1, 1).Interior.ColorIndex = 6
      End If
      
   Next カウンタ

End Sub


Function HTML取得ShiftJIS2UNICODE(url)

   'URLからHTML(ShiftJIS)を取得してUNICODEに変換して出力する関数
   Set XMLHTTPオブジェクト = CreateObject("MSXML2.XMLHTTP")

   Call XMLHTTPオブジェクト.Open("GET", url, False)
   'http://www.ajaxtower.jp/ini/http/index2.html

   Call XMLHTTPオブジェクト.send

   HTML取得ShiftJIS2UNICODE = StrConv(XMLHTTPオブジェクト.responseBody, vbUnicode)
   
End Function

 解説:
 MSXML2.XMLHTTPの「open」メソッド はサーバに対するHTTPリクエストを作成します。
1 番目の引数は、リクエストが「GET」なのか「POST」なのかを指定します。(必須)
2 番目の引数は、リクエストを送るURLを指定します。 (必須)
3 番目の引数は、非同期通信か同期通信かを指定します。
 同期通信の場合は「false」を、非同期通信の場合は「true」を指定します。省略した場合は「true」が設定されます。
 同期通信にした場合はサーバに対するリクエストからの応答があるまで待ってから次の処理へ進みます。  その為、処理が移った時点では既に応答が帰ってきていますので、その応答に対する処理を記述するだけなので記述は簡単になります。
 その代わり応答が帰ってくるまでブラウザは他の処理を行えません。
 非同期通信にした場合にはリクエストを送った時点で次の処理へ進みます。
 その為、リクエストを送信したブラウザではすぐに他の処理を行えますが、今度は応答に対する処理を行うには、応答が帰ってきたのかどうかを別途調べる処理が必要となります。


responseBody プロパティ Shift_JIS は、responseText だと文字化けします。このため、responseBody でバイト配列(バイナリ)として取得し、vbUnicode(ユニコード)に変換して文字列として取得します。


Hyperlinks オブジェクト は、ワークシートまたはセル範囲のハイパーリンクのコレクションを表します。
各ハイパーリンクは、Hyperlink オブジェクトで表されます。

Hyperlinks コレクションを取得するには、Hyperlinks プロパティを使用します。
次の使用例は、ワークシート 1 上のハイパーリンクで "Microsoft" という単語を含むものを調べます。

For Each h in Worksheets(1).Hyperlinks
    If Instr(h.Name, "Microsoft") <> 0 Then h.Follow
Next

ハイパーリンクを作成し、それを Hyperlinks コレクションに追加するには、Add メソッドを使用します。
次の使用例は、セル E5 に新しいハイパーリンクを作成します。
With Worksheets(1)
    .Hyperlinks.Add .Range("E5"), "http://www.gohere.com"
End With

Hyperlinks.Add メソッド は、指定された範囲または図形にハイパーリンクを追加します。

構文
.Add(Anchor, Address, SubAddress, ScreenTip, TextToDisplay)
   Hyperlinks オブジェクトを表す変数です。
パラメータ
名前必須/オプションデータ型説明
Anchor必須オブジェクト型 (Object)ハイパーリンクのアンカーを指定します。
Range オブジェクトまたは Shape オブジェクトを指定します。
Address必須文字列型 (String)ハイパーリンクのアドレスを指定します。
SubAddressオプションバリアント型 (Variant)ハイパーリンクのサブアドレスを指定します。
ScreenTipオプションバリアント型 (Variant)ハイパーリンク上をマウス ポインタで指した場合に表示されるヒントを指定します。
TextToDisplayオプションバリアント型 (Variant)ハイパーリンクで表示されるテキストを指定します。
戻り値
新しいハイパーリンクを表す Hyperlink オブジェクト。
備考
引数 TextToDisplay を指定する場合、テキストには文字列を指定する必要があります。

次の使用例は、セル A5 にハイパーリンクを追加します。
With Worksheets(1)
    .Hyperlinks.Add Anchor:=.Range("a5"), _
        Address:="http://example.microsoft.com", _
        ScreenTip:="Microsoft Web Site", _
        TextToDisplay:="Microsoft"
End With

次の使用例は、セル A5 に電子メールのハイパーリンクを追加します。
With Worksheets(1)
    .Hyperlinks.Add Anchor:=.Range("a5"), _
        Address:="mailto:someone@example.com?subject=hello", _
        ScreenTip:="Write us today", _
        TextToDisplay:="Support"
End With

株取引に VBA を使うの目次に戻る Excel VBAの目次に戻る↑ 索引へ↓ トップページに戻る


指定銘柄の理論株価と対比

 このマクロを使うと、指定した銘柄コードについて、直近の株価と理論株価を取得し、その比率を計算します。

1.マクロの機能
 指定した銘柄コードについて、理論株価Web から企業名称、株価、理論株価を取得して、株価/理論株価 を計算して色区分します。

2.使い方
 注目したい企業の銘柄コードを登録して、「開始」ボタンを押すだけ。
(サンプル・データを登録済なので、すぐお試しできます。

3.補足
 前回処理で、銘柄コードや株価データが残っていても、マクロの処理の中で削除します。
このため、このブックを開いて、「指定登録」のシートで「開始」ボタンを押すだけで、該当データを取得できます。

このマクロをダウンロードできます。→TheoreticalStockPriceVBA01

Option Explicit
Option Base 1

'参考にさせていただいたサイト

'システムトレーダーの冒険の書
'http://yutarosnotebook.blog.fc2.com/
'時系列株価を取得できるVBScriptプログラム(ソース公開)
'http://yutarosnotebook.blog.fc2.com/blog-entry-104.html

'01:2016/12/13:作成

   Dim XMLHTTPオブジェクト As Object
   
Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
'これで Sleepを使ってミリ秒単位で処理にウェイトを入れることができます。
   
   
Sub 理論株価を取得()

   Dim URL理論株価Web  As String
   Dim 文字列 As String
   Dim 銘柄コード As String
   Dim HTMLソース As String
   Dim 開始日時 As Variant
   Dim 終了日時 As Variant
   Dim 最終行 As Integer
   Dim 銘柄数 As Integer
   Dim 銘柄カウンタ As Integer
   Dim 番台 As String
   Dim 指定URL As String
   Dim 銘柄名 As String
   Dim 株価 As Single
   Dim 日付 As String
   Dim 理論株価 As Single
   Dim 文字配列
   Dim ページ行数 As Integer
   Dim 行数 As Integer
   Dim 行文字列 As String
   Dim 株価取得済 As String
   
   
   '理論株価Webから指定銘柄の理論株価を取得し、Excelシートに書き出すツールです。
   
   開始日時 = Now                ' 開始時刻を変数に格納します。
   
   ' 処理を高速化するため、自動計算停止
   Application.Calculation = xlCalculationManual

   'シートから基本情報を取得
   ThisWorkbook.Worksheets("指定登録").Activate
   URL理論株価Web = Range("B1").Value
   最終行 = Cells(ActiveSheet.Rows.Count, 1).End(xlUp).Row
   銘柄数 = 最終行 - 5
   
   '前回取得データを消去
   If 最終行 > 5 Then
      Range("B6:G" & 最終行).ClearContents
   End If
   
   Columns("B:F").Interior.Pattern = xlNone
'   Range("F6").Cells(銘柄カウンタ, 1).Interior.ColorIndex = xlColorIndexNone

   '銘柄を昇順に並び替え
   Range("A5").CurrentRegion.Sort _
      Key1:=Range("A5"), Order1:=xlAscending, _
      Header:=xlYes
   
   '以上が設定です。ここより下の行はメインプログラムとなります。
   
   For 銘柄カウンタ = 1 To 銘柄数
      株価取得済 = ""
      株価 = 0
      理論株価 = 0
      日付 = ""
      
      '株価コードを設定します
      銘柄コード = Range("A6").Cells(銘柄カウンタ, 1).Value
      番台 = Left(銘柄コード, 1) & String(3, "0")
      
      指定URL = URL理論株価Web & 番台 & "/" & 銘柄コード & ".htm"
      
      'WEB ページが Shift_JIS のためUNICODEに変換して取得
      HTMLソース = HTML取得ShiftJIS2UNICODE(指定URL)
      
      '1行ずつに分割
      文字配列 = Split(HTMLソース, vbNewLine)
      '全体行数を取得
      ページ行数 = UBound(文字配列)

      If ページ行数 = 0 Then
         Erase 文字配列
         '1行ずつに分割
         文字配列 = Split(HTMLソース, vbLf) '★★★ HTML の改行が Lf (UNIX系OS)の場合にも対応 ★★★
         '全体行数を取得
         ページ行数 = UBound(文字配列)
      End If

'      If 銘柄コード = "1357" Then Stop

      For 行数 = 1 To ページ行数
         行文字列 = 文字配列(行数)
         
         Debug.Print 行数
         Debug.Print 行文字列
           
         If InStr(行文字列, "<title>404") > 0 Then
            Range("B6").Cells(銘柄カウンタ, 1).Value = "ページが見つかりません"
            Exit For
         End If
         
         If InStr(行文字列, "<title>理論株価Web") > 0 Then
            銘柄名 = Trim(正規表現で置換("<(.*?)>", 行文字列, ""))
            銘柄名 = Right(銘柄名, Len(銘柄名) - InStr(銘柄名, ">"))
         End If
         
         If InStr(行文字列, "上場廃止") > 0 Then
            Range("B6").Cells(銘柄カウンタ, 1).Value = 銘柄名
            Range("D6").Cells(銘柄カウンタ, 1).Value = "上場廃止"
            Exit For
         End If
  
         If 株価取得済 = "" Then
            If InStr(行文字列, "<th class=""right_35"">株価</th>") > 0 Then
               行文字列 = 文字配列(行数 + 1)
               株価 = Trim(正規表現で置換("<(.*?)>", 行文字列, ""))
               行文字列 = 文字配列(行数 + 2)
               日付 = Trim(正規表現で置換("<(.*?)>", 行文字列, ""))

               行数 = 行数 + 2
               株価取得済 = "株価取得済"
            End If
         End If
         
         If InStr(行文字列, "<th class=""right_35"">理論株価</th>") > 0 Then
            行文字列 = 文字配列(行数 + 1)
            文字列 = Trim(正規表現で置換("<(.*?)>", 行文字列, ""))
            文字列 = Trim(Replace(文字列, "予", ""))
            文字列 = Trim(Replace(文字列, ",", ""))
            理論株価 = Val(文字列)

            Range("B6").Cells(銘柄カウンタ, 1).Value = 銘柄名
            Range("C6").Cells(銘柄カウンタ, 1).Value = 株価
            Range("D6").Cells(銘柄カウンタ, 1).Value = 日付
            Range("E6").Cells(銘柄カウンタ, 1).Value = 理論株価
'            Stop
            If Range("E6").Cells(銘柄カウンタ, 1).Value <> 0 Then
            
               Range("F6").Cells(銘柄カウンタ, 1).Value _
               = Range("C6").Cells(銘柄カウンタ, 1).Value / Range("E6").Cells(銘柄カウンタ, 1).Value
               
               If Range("E6").Cells(銘柄カウンタ, 1).Value < 100 Then
                  Range("E6").Cells(銘柄カウンタ, 1).Interior.ColorIndex = 3
               End If
               
               If Range("F6").Cells(銘柄カウンタ, 1).Value > 10 Then
                  Range("B6").Cells(銘柄カウンタ, 1).Interior.ColorIndex = 3
                  Range("F6").Cells(銘柄カウンタ, 1).Interior.ColorIndex = 3
               ElseIf Range("F6").Cells(銘柄カウンタ, 1).Value > 1.1 Then
                  Range("B6").Cells(銘柄カウンタ, 1).Interior.ColorIndex = 22
                  Range("F6").Cells(銘柄カウンタ, 1).Interior.ColorIndex = 22
               ElseIf Range("F6").Cells(銘柄カウンタ, 1).Value < 0.9 Then
                  Range("B6").Cells(銘柄カウンタ, 1).Interior.ColorIndex = 4
                  Range("F6").Cells(銘柄カウンタ, 1).Interior.ColorIndex = 4
               End If
            End If
            
            Exit For
         End If
      Next 行数 'html の Body データを一行ごとに読む

'Stop
   Next 銘柄カウンタ
   
   ' 自動計算停止解除
   Application.Calculation = xlCalculationAutomatic
    
   終了日時 = Now
   MsgBox "処理時間は、" _
   & Format(終了日時 - 開始日時, "hh時間nn分ss秒") & " でした。"

End Sub

解説:
 セルの背景色は、Interior.Color か Interior.ColorIndex プロパティのどちらかを設定します。
2つは、色の指定の仕方が異なるだけで、結果は同じです。
Interior.Color      ・・・ 色定数またはRGB値で色を指定します。
Interior.ColorIndex ・・・ カラーパレットのインデックス値で色を指定します。
Interior.Pattern    ・・・ パターンの種類で背景色を指定します。

株取引に VBA を使うの目次に戻る Excel VBAの目次に戻る↑ 索引へ↓ トップページに戻る


信用売残・買残、日証金貸株・融資の増加上位の情報取得

 このマクロを使うと、信用ランキング上位銘柄とその株価推移を知ることができます。

1.マクロの機能
 (1).トレーダーズ・ウェブ(株式情報、FX情報) から「信用ランキング」の銘柄コードを取得します。
 (2).Yahoo!ファイナンス 株式/株価 から該当コードの過去80日間の株価データを取得してシートに書き出します。
 (3).株探 Kabutan から、該当コードの信用残の時系列データを追記します。
 (4).karauri.net から、機関の空売り残高情報を追記します。

2.使い方
「開始」ボタンを押すだけ。

3.補足
前回処理で、銘柄コードや株価データ・シートが残っていても、マクロの処理の中で削除します。
このため、このブックを開いて、「指定登録」のシートで「開始」ボタンを押すだけで、最新の対象銘柄と、その株価データを取得できます。

このマクロをダウンロードできます。→MarginTransactions&StockPricesVBA03.xls

Option Explicit
Option Base 1


'00:2015/09/18:作成
'01:2015/09/19:指定登録シートにYahooの株価と上昇下落率を追加

   Dim XMLHTTPオブジェクト As Object
   Dim URL株式株価Yahooファイナンス As String
   Dim 文字列 As String
   
   Dim 銘柄コード As String
   Dim ソース保存フォルダ As String
   
   Dim 計算日付 As Date
   Dim 前計算日付 As Date

Sub 信用ランキング20位の時系列株価を取得()

   Dim 開始日時 As Variant
   Dim 終了日時 As Variant
   
   開始日時 = Now                ' 開始時刻を変数に格納します。
   
   ' 処理を高速化するため、自動計算停止
   Application.Calculation = xlCalculationManual
   
   Call トレーダーズウェブから信用取引情報を取得
   Call 時系列株価を取得_コード重複対策付き
   
   ThisWorkbook.Worksheets("指定登録").Activate
   
   ' 自動計算停止解除
   Application.Calculation = xlCalculationAutomatic
    
   終了日時 = Now
   MsgBox "処理時間は、" _
   & Format(終了日時 - 開始日時, "hh時間nn分ss秒") & " でした。"
   
End Sub



Private Sub トレーダーズウェブから信用取引情報を取得()

   Dim URL信用ランキング As String
   Dim SubMatchesコレクション As Object
   Dim ファイルシステムオブジェクト As Object
   Dim 出力ファイルパス As String
   Dim キストストリームオブジェクト As Object
   Dim ソース保存フォルダ As String
   Dim 正規表現 As RegExp
   Dim HTMLソース As String
   Dim カウンタ As Integer
   Dim 最終行 As Integer
   Dim 日付 As Date
   Dim 銘柄コード As String
   Dim 銘柄名 As String
   Dim 列数 As Integer

   ThisWorkbook.Worksheets("指定登録").Activate
   URL信用ランキング = Range("B4").Value
   ソース保存フォルダ = Range("B3").Value

   '前回の取得銘柄のデータを削除
   最終行 = Cells(ActiveSheet.Rows.Count, 1).End(xlUp).Row
   Range("A6:J" & CStr(最終行)).Delete Shift:=xlUp

   Set ファイルシステムオブジェクト = CreateObject("Scripting.FileSystemObject")

   If Dir(ソース保存フォルダ, vbDirectory) = "" Then 'この名前のフォルダが存在しなければ
      MkDir ソース保存フォルダ
   End If
   
   Set 正規表現 = New RegExp

   '<tr><td class="td_con_ranking_5" align="right">4</td><td class="td_con_ranking_7" align="center">6888</td><td class="td_con_ranking_28" align="left">アクモス</td><td class="td_con_ranking_8" align="right">205.0</td><td class="td_con_ranking_13" align="right">624,100</td><td class="td_con_ranking_13y" align="right">442,400</td><td class="td_con_ranking_13" align="right">574,200</td><td class="td_con_ranking_13" align="right">165,300</td></tr>
   '<tr><td class="td_con_ranking_5" align="right">5</td><td class="td_con_ranking_7" align="center">7707</td><td class="td_con_ranking_28" align="left"> </td><td class="td_con_ranking_8" align="right"> </td><td class="td_con_ranking_13" align="right">413,000</td><td class="td_con_ranking_13y" align="right">413,000</td><td class="td_con_ranking_13" align="right">209,300</td><td class="td_con_ranking_13" align="right">209,300</td></tr>
   '                                                                       コード                                                      銘柄名                                                     現在値                                                            売残                                                            売残前週比                                                        買残                                                            買残前週比
   '<tr>.+?class="td_con_ranking_7" align="center">([0-9]{4})</td><td class="td_con_ranking_28" align="left">(.+?)</td><td class="td_con_ranking_8" align="right">([\.0-9|,]+)</td><td class="td_con_ranking_13" align="right">([\.0-9|,]+)</td><td class="td_con_ranking_13y" align="right">([\.0-9|,]+)</td><td class="td_con_ranking_13" align="right">([\.0-9|,]+)</td><td class="td_con_ranking_13" align="right">([\.0-9|,|-]+)</td>
   正規表現.Pattern = "<tr>.+?class=""td_con_ranking_7"" align=""center"">([0-9]{4})</td><td class=""td_con_ranking_28"" align=""left"">(.*?)</td><td class=""td_con_ranking_8"" align=""right"">([\.0-9|,| ]*)</td><td class=""td_con_ranking_13"" align=""right"">([\.0-9|,]+)</td><td class=""td_con_ranking_13y"" align=""right"">([\.0-9|,|-]+)</td><td class=""td_con_ranking_13"" align=""right"">([\.0-9|,]+)</td><td class=""td_con_ranking_13"" align=""right"">([\.0-9|,|-]+)</td>"
   
   正規表現.Global = True
   
   出力ファイルパス = ファイルシステムオブジェクト.buildPath(ソース保存フォルダ, "信用売残増加銘柄.txt")
   '構文:object.CreateTextFile(filename[, overwrite[, unicode]]) → ShiftJIS だとエラーになる文字があるため↓
   'http://blog.systemjp.net/entry/2013/04/10/191821 ←教えていただいたサイト
   'http://ameblo.jp/cashtray/entry-11066671774.html ←教えていただいたサイト
   Set キストストリームオブジェクト = ファイルシステムオブジェクト.CreateTextFile(出力ファイルパス, True, True)
   
   'WEB ページが Shift_JIS のためUNICODEに変換して取得
   HTMLソース = HTML取得ShiftJIS2UNICODE(URL信用ランキング)
   
   
   '検証用にHTMLソースを出力
   キストストリームオブジェクト.writeLine HTMLソース
   
   Set SubMatchesコレクション = 正規表現.Execute(HTMLソース)
   
   '1つめのマッチから順に、最後のマッチまで
   For カウンタ = 0 To SubMatchesコレクション.Count - 1
   
      銘柄コード = SubMatchesコレクション.Item(カウンタ).SubMatches(0)
      ActiveSheet.Hyperlinks.Add Anchor:=Range("A6").Cells(カウンタ + 1, 1), Address:="", _
      SubAddress:="'" & 銘柄コード & "'!A1", TextToDisplay:=銘柄コード
      
      銘柄名 = SubMatchesコレクション.Item(カウンタ).SubMatches(1)
      If 銘柄名 = "&nbsp;" Then
         銘柄名 = "空白"
      End If
      ActiveSheet.Hyperlinks.Add Anchor:=Range("B6").Cells(カウンタ + 1, 1), Address:="", _
      SubAddress:="'" & 銘柄コード & "'!A1", TextToDisplay:=銘柄名
      
      For 列数 = 1 To 5
         Range("F6").Cells(カウンタ + 1, 列数).Value = SubMatchesコレクション.Item(カウンタ).SubMatches(列数 + 1)
      Next 列数
      
      '信用売残増加ランキングと信用買残増加ランキングを色区分する
      If カウンタ < 20 Then
         Range("H6").Cells(カウンタ + 1, 1).Interior.ColorIndex = 4
      ElseIf カウンタ < 40 Then
         Range("J6").Cells(カウンタ + 1, 1).Interior.ColorIndex = 4
      End If
      
   Next カウンタ

End Sub



Private Sub 時系列株価を取得_コード重複対策付き()

   Dim HTMLタイトル As String
   Dim 正規表現タイトル As RegExp
   Dim Matchesコレクション As Object
   
'   Dim 銘柄コード As String
'   Dim ソース保存フォルダ As String
   Dim 取得ページ数 As Integer
   Dim ファイルシステムオブジェクト As Object
   Dim 出力ファイルパス As String
   Dim キストストリームオブジェクト As Object
   Dim 正規表現 As RegExp
   Dim 取得ページカウンタ As Integer
   Dim HTMLソース As String
   Dim SubMatchesコレクション As Object
   Dim カウンタ As Integer

   Dim 追加シート名初期 As String
   Dim 追加シート名 As String
   Dim 重複 As Integer
   Dim シート As Worksheet
   Dim シート数 As Integer

   Dim 列数 As Integer
   Dim 行数 As Integer
   Dim 文字列 As String
   Dim 銘柄配列() As Variant
   Dim 最終行 As Integer
   Dim 銘柄数 As Integer
   Dim 銘柄カウンタ As Integer
   Dim 処理行 As Integer
   Dim 銘柄コード索引 As Object        'Scripting.Dictionary オブジェクト
   Dim 指定登録シート As Worksheet
   Dim 標準偏差 As Single
   

   '★銘柄コード索引を作成★
   Set 銘柄コード索引 = CreateObject("Scripting.Dictionary")  '★連想配列の定義
   
   '時系列株価を取得し、Excelシートに書き出すツールです。
   
   '前回作成したシートがあれば削除
   For Each シート In ThisWorkbook.Worksheets
      If シート.Name <> "テンプレート" And シート.Name <> "指定登録" Then
         'シート名 テンプレート と 指定登録 以外のシートを削除
         Application.DisplayAlerts = False
         シート.Delete
         Application.DisplayAlerts = True
      End If
   Next シート
   
   ThisWorkbook.Worksheets("指定登録").Activate
   URL株式株価Yahooファイナンス = Range("B1").Value
   取得ページ数 = Int(Range("B2").Value / 20 + 0.99)
   最終行 = Cells(ActiveSheet.Rows.Count, 1).End(xlUp).Row
   銘柄数 = 最終行 - 5
   銘柄配列 = Range("A6").Resize(銘柄数, 1)
   ソース保存フォルダ = Range("B3").Value
   Set 指定登録シート = ActiveSheet
   
   
   '以上が設定です。ここより下の行はメインプログラムとなります。
   
   Set ファイルシステムオブジェクト = CreateObject("Scripting.FileSystemObject")
   
   If Dir(ソース保存フォルダ, vbDirectory) = "" Then 'この名前のフォルダが存在しなければ
      MkDir ソース保存フォルダ
   End If

   Set 正規表現 = New RegExp
   正規表現.Pattern = "(\d{4}年\d{1,2}月\d{1,2}日)</td><td>([\.0-9|,]+)</td><td>([\.0-9|,]+)</td><td>([\.0-9|,]+)</td><td>([\.0-9|,]+)</td><td>([\.0-9|,]+)</td><td>([\.0-9|,]+)"
   正規表現.Global = True
   
   'HTML のタイトル抽出用
   Set 正規表現タイトル = New RegExp
   With 正規表現タイトル
      .Pattern = "<title>.*</title>"
      .IgnoreCase = True '大文字小文字を区分しない
      .Global = False
   End With
   
   For 銘柄カウンタ = 1 To 銘柄数
   
      '株価コードを設定します
      銘柄コード = 銘柄配列(銘柄カウンタ, 1)
      
      '株価コードの既存チェック
      If 銘柄コード索引.Exists(銘柄コード) = False Then
         '新規銘柄コードの場合のみ、時系列データを取得する
         銘柄コード索引(銘柄コード) = 銘柄カウンタ
      
         出力ファイルパス = ファイルシステムオブジェクト.buildPath(ソース保存フォルダ, 銘柄コード & ".txt")
         '構文:object.CreateTextFile(filename[, overwrite[, unicode]]) → ShiftJIS だとエラーになる文字があるため↓
         'http://blog.systemjp.net/entry/2013/04/10/191821 ←教えていただいたサイト
         'http://ameblo.jp/cashtray/entry-11066671774.html ←教えていただいたサイト
         Set キストストリームオブジェクト = ファイルシステムオブジェクト.CreateTextFile(出力ファイルパス, True, True)
   
         追加シート名初期 = 銘柄コード
         追加シート名 = 追加シート名初期
      
         For 重複 = 1 To 100
         ' 100枚まで追加しても重複しないように追番を設定します。
             For Each シート In Worksheets
                 If シート.Name = 追加シート名 Then
                     追加シート名 = 追加シート名初期 & "(" & 重複 & ")"
                 End If
             Next シート
         Next 重複
         シート数 = Worksheets.Count
         Worksheets("テンプレート").Copy After:=Worksheets(シート数)
         ActiveSheet.Name = 追加シート名
         
         行数 = 0
         For 取得ページカウンタ = 1 To 取得ページ数
            HTMLソース = HTML取得(URL結合(銘柄コード, Date - 80 * 取得ページカウンタ, Date, 取得ページカウンタ))
             
            Range("A2").Value = URL結合(銘柄コード, Date - 80 * 取得ページカウンタ, Date, 取得ページカウンタ)
      
            '検証用にHTMLソースを出力
            キストストリームオブジェクト.writeLine HTMLソース
               
            'HTML のタイトル抽出
            Set Matchesコレクション = 正規表現タイトル.Execute(HTMLソース)
            文字列 = Matchesコレクション.Item(0).Value
            HTMLタイトル = Trim(正規表現で置換("<(.*?)>", 文字列, ""))
               
            If InStr(HTMLタイトル, ":") > 0 Then
               Range("A1").Value = Trim(Left(HTMLタイトル, InStr(HTMLタイトル, ":") - 1))
            Else
               Range("A1").Value = HTMLタイトル
            End If
   
            '1行目から順に、最後の行まで
         
            Set SubMatchesコレクション = 正規表現.Execute(HTMLソース)
            For カウンタ = 0 To SubMatchesコレクション.Count - 1
               行数 = 行数 + 1
               For 列数 = 1 To 7
                  Range("A4").Cells(行数, 列数).Value = SubMatchesコレクション.Item(カウンタ).SubMatches(列数 - 1)
               Next 列数
            Next カウンタ

         Next 取得ページカウンタ
         
         キストストリームオブジェクト.Close
         
         最終行 = Cells(ActiveSheet.Rows.Count, 1).End(xlUp).Row
         For 処理行 = 4 To 最終行 - 1
            '上昇下落率を計算してセルに書き出し
            Range("H1").Cells(処理行, 1).Value _
            = (Range("G1").Cells(処理行, 1).Value - Range("G1").Cells(処理行 + 1, 1).Value) / Range("G1").Cells(処理行 + 1, 1).Value
            
            If Range("H1").Cells(処理行, 1).Value >= 0.1 Then
               Range("H1").Cells(処理行, 1).Interior.ColorIndex = 7
            ElseIf Range("H1").Cells(処理行, 1).Value >= 0 Then
               Range("H1").Cells(処理行, 1).Interior.ColorIndex = 38
            ElseIf Range("H1").Cells(処理行, 1).Value <= -0.1 Then
               Range("H1").Cells(処理行, 1).Interior.ColorIndex = 8
            ElseIf Range("H1").Cells(処理行, 1).Value < 0 Then
               Range("H1").Cells(処理行, 1).Interior.ColorIndex = 20
            End If
         Next 処理行
         
         '標準偏差σを計算して、セルG1に登録
            '自動計算停止解除
         Application.Calculation = xlCalculationAutomatic
         Range("G1").Formula = "=STDEV(G4:G" & 最終行 & ")"
         標準偏差 = Range("G1").Value
            '処理を高速化するため、自動計算を再停止
         Application.Calculation = xlCalculationManual
         Range("G1").Value = 標準偏差
         
         '上昇下落率を指定登録シートに転記
         指定登録シート.Range("D6").Cells(銘柄カウンタ, 1).Value = Range("H4").Value
         '直近株価を指定登録シートに転記
         指定登録シート.Range("E6").Cells(銘柄カウンタ, 1).Value = Range("G4").Value
         '直近株価に対する標準偏差の率を指定登録シートに転記
         指定登録シート.Range("C6").Cells(銘柄カウンタ, 1).Value = Range("G1").Value / Range("G4").Value
         '標準偏差率が10%以上に水色を付ける
         If 指定登録シート.Range("C6").Cells(銘柄カウンタ, 1).Value >= 0.1 Then
            指定登録シート.Range("C6").Cells(銘柄カウンタ, 1).Interior.ColorIndex = 8
         End If
         
         Call 信用残時系列を追記
         Call 機関の空売り残高情報を追記
         
      Else
         '銘柄が既存の場合は、既に取得済の標準偏差率、上昇下落率、直近株価を転記
         For 列数 = 1 To 3
         指定登録シート.Range("C6").Cells(銘柄カウンタ, 列数).Value _
         = 指定登録シート.Range("C6").Cells(銘柄コード索引(銘柄コード), 列数).Value
         Next 列数
         '重複出現がわかるようにセル背景を黄色に
         指定登録シート.Range("A6").Cells(銘柄カウンタ, 1).Resize(1, 2).Interior.ColorIndex = 6
         指定登録シート.Range("A6").Cells(銘柄コード索引(銘柄コード), 1).Resize(1, 2).Interior.ColorIndex = 6

      End If
      
   Next 銘柄カウンタ

End Sub



Private Sub 機関の空売り残高情報を追記()
   Dim ファイルシステムオブジェクト As Object
   Dim 出力ファイルパス As String
   Dim キストストリームオブジェクト As Object
   Dim 正規表現 As RegExp
   Dim HTMLソース As String
   Dim SubMatchesコレクション As Object
   Dim カウンタ As Integer
   Dim 行数 As Integer
   Dim 最終行 As Integer
   
   Dim URL_karauri_net As String
   Dim 株価日付 As Date

   
   '機関の空売り残高情報を取得して、時系列株価情報のExcelシートに追記します。
   
   URL_karauri_net = "http://karauri.net/"

   Set 正規表現 = New RegExp
   '                計算日                空売り者             残高割合                増減率                残高数量               増減量                備考
   正規表現.Pattern = ">([0-9]{4}/[0-9]{2}/[0-9]{2})<.*/td><td class=""lf""><a .+?>(.*?)</a></td><td class=""ct"">([\.0-9|,]+%)</td><td class=""ct.*?"">([\.0-9|+,-]+%)</td><td class=""ct"">([\.0-9|,]+株)</td><td.*?>([\.0-9|+,-]*)</td><td class=""lf"".*?>(.*)<.*?/td></tr>"
   正規表現.Global = True
   

   HTMLソース = HTML取得(URL_karauri_net & 銘柄コード & "/")
   
   '</tr>の後に改行を追加してソースを見やすくする
   HTMLソース = 正規表現で置換("</tr>", HTMLソース, "</tr>★改行★")
   HTMLソース = Replace(HTMLソース, "★改行★", vbNewLine)
   
   '検証用にHTMLソースを出力
   Set ファイルシステムオブジェクト = CreateObject("Scripting.FileSystemObject")
   出力ファイルパス = ファイルシステムオブジェクト.buildPath(ソース保存フォルダ, 銘柄コード & "空売り残高情報.txt")
   '構文:object.CreateTextFile(filename[, overwrite[, unicode]]) → ShiftJIS だとエラーになる文字があるため↓
   'http://blog.systemjp.net/entry/2013/04/10/191821 ←教えていただいたサイト
   'http://ameblo.jp/cashtray/entry-11066671774.html ←教えていただいたサイト
   Set キストストリームオブジェクト = ファイルシステムオブジェクト.CreateTextFile(出力ファイルパス, True, True)
   キストストリームオブジェクト.writeLine HTMLソース
   
'   Stop
   
   '1行目から順に、最後の行まで

   Set SubMatchesコレクション = 正規表現.Execute(HTMLソース)
   
   最終行 = Cells(ActiveSheet.Rows.Count, 1).End(xlUp).Row
   行数 = 0
   
   For カウンタ = 0 To SubMatchesコレクション.Count - 1
   
      計算日付 = SubMatchesコレクション.Item(カウンタ).SubMatches(0)

      If 計算日付 = 前計算日付 Then
         行数 = 行数 + 1
         'コピーや切取りの操作を取り消します
         Application.CutCopyMode = False
         '行を追加します
         Range("A4").Cells(行数, 1).EntireRow.Insert
         Range("A4").Cells(行数, 1).Value = Range("A4").Cells(行数 - 1, 1).Value
         最終行 = 最終行 + 1
         
         If 計算日付 = 株価日付 Then
            Call 機関の日付列データ登録(SubMatchesコレクション, カウンタ, 行数)
         End If
         
      Else
         Do While 計算日付 <> 株価日付
            行数 = 行数 + 1
            If 行数 > 最終行 Then Exit Do '信用残日付データの方が株価日付のデータより多い場合は、抜ける
            
            株価日付 = Range("A4").Cells(行数, 1).Value
            
            If 計算日付 = 株価日付 Then
               Call 機関の日付列データ登録(SubMatchesコレクション, カウンタ, 行数)
               Exit Do
            ElseIf 株価日付 <> "0:00:00" And 計算日付 > 株価日付 Then
            
               '行を追加します
               Range("A4").Cells(行数, 1).EntireRow.Insert
               Range("A4").Cells(行数, 1).Value = 計算日付
               
               Call 機関の日付列データ登録(SubMatchesコレクション, カウンタ, 行数)
   
               最終行 = 最終行 + 1
               Exit Do
            End If
         Loop

      End If
   Next カウンタ

End Sub



Private Sub 機関の日付列データ登録(SubMatchesコレクション, カウンタ, 行数)
   Dim 列数 As Integer
   For 列数 = 1 To 6
         文字列 = SubMatchesコレクション.Item(カウンタ).SubMatches(列数)
         Range("L4").Cells(行数, 列数).Value = 正規表現で置換("<(.*?)>", 文字列, "")
   Next 列数
   前計算日付 = 計算日付
End Sub



Private Sub 信用残時系列を追記()

   Dim ファイルシステムオブジェクト As Object
   Dim 出力ファイルパス As String
   Dim キストストリームオブジェクト As Object
   Dim 正規表現 As RegExp
   Dim HTMLソース As String
   Dim SubMatchesコレクション As Object
   Dim カウンタ As Integer

   Dim 列数 As Integer
   Dim 行数 As Integer
   Dim 最終行 As Integer
   
   Dim URL株探Kabutan信用残 As String
   Dim 株価日付 As Date
   Dim 信用残日付 As Date

   
   '信用残時系列データを取得して、時系列株価情報のExcelシートに追記します。
   
   URL株探Kabutan信用残 = "http://kabutan.jp/stock/kabuka?code="

   Set 正規表現 = New RegExp
   '                                                          日付                                売残                 買残                信用倍率
   正規表現.Pattern = "<td style=""text-align:center;"">([0-9]{2}/[0-9]{2}/[0-9]{2})</td>.*<td>([,0-9|−]+)</td><td>([,0-9|−]+)</td><td>([\.0-9|,|−]+)</td></tr>"
   正規表現.Global = True
   

   HTMLソース = HTML取得(URL株探Kabutan信用残 & 銘柄コード & "&ashi=shin")
   
   '</td>の後の改行を外す
   HTMLソース = 正規表現で置換("</td>\r\n", HTMLソース, "</td>")
   
   '検証用にHTMLソースを出力
   Set ファイルシステムオブジェクト = CreateObject("Scripting.FileSystemObject")
   出力ファイルパス = ファイルシステムオブジェクト.buildPath(ソース保存フォルダ, 銘柄コード & "信用残時系列.txt")
   '構文:object.CreateTextFile(filename[, overwrite[, unicode]]) → ShiftJIS だとエラーになる文字があるため↓
   'http://blog.systemjp.net/entry/2013/04/10/191821 ←教えていただいたサイト
   'http://ameblo.jp/cashtray/entry-11066671774.html ←教えていただいたサイト
   Set キストストリームオブジェクト = ファイルシステムオブジェクト.CreateTextFile(出力ファイルパス, True, True)
   キストストリームオブジェクト.writeLine HTMLソース

   '1行目から順に、最後の行まで

   Set SubMatchesコレクション = 正規表現.Execute(HTMLソース)
   
   最終行 = Cells(ActiveSheet.Rows.Count, 1).End(xlUp).Row
   行数 = 0
   
   For カウンタ = 0 To SubMatchesコレクション.Count - 1
   
      信用残日付 = SubMatchesコレクション.Item(カウンタ).SubMatches(0)
      
      Do While 信用残日付 <> 株価日付
         行数 = 行数 + 1
         If 行数 > 最終行 Then Exit Do '信用残日付データの方が株価日付のデータより多い場合は、抜ける
         
         株価日付 = Range("A4").Cells(行数, 1).Value
         If 信用残日付 = 株価日付 Then
            For 列数 = 1 To 3
               Range("I4").Cells(行数, 列数).Value = SubMatchesコレクション.Item(カウンタ).SubMatches(列数)
            Next 列数
            
         End If
      Loop
      
   Next カウンタ
       
End Sub

株取引に VBA を使うの目次に戻る Excel VBAの目次に戻る↑ 索引へ↓ トップページに戻る


インターネットから株価を取得3 (createDocumentFromUrl を使う)

 HTMLDocument.createDocumentFromUrl でも、IE を使わずにHTMLソースを取得できることを知りました。

上の「インターネットから株価を取得2 (MSXML2.XMLHTTP を使う)」を書き換えて見ました。
処理速度的には、上の「インターネットから株価を取得2 (MSXML2.XMLHTTP を使う)」の方が5倍以上速いのですが、HTMLDocument の要素を使って属性を抽出するときには利用価値があるかもしれないので、ここに掲示します。

このマクロをダウンロードできます。→GetTimeSeriesStockPricesHTMLDocumentVBA01.xls

Option Explicit
Option Base 1


'00:2015/07/20:「GetTimeSeriesStockPricesVBA03.xls」をベースに、対象HTMLDocument.createDocumentFromUrl()を使うように移植


   Dim URL株式株価Yahooファイナンス As String

   Dim HTMLソース As String
   Dim HTMLタイトル As String
   
Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
'これで Sleepを使ってミリ秒単位で処理にウェイトを入れることができます。

Sub 時系列株価を取得()
   
   Dim 銘柄コード As String
   Dim SaveFolder As String
   Dim 取得ページ数 As Integer
   Dim ファイルシステムオブジェクト As Object
   Dim 出力ファイルパス As String
   Dim キストストリームオブジェクト As Object
   Dim 正規表現 As RegExp
   Dim 取得ページカウンタ As Integer

   Dim SubMatchesコレクション As Object
   Dim カウンタ As Integer
   Dim 開始日時 As Variant
   Dim 終了日時 As Variant
   Dim 追加シート名初期 As String
   Dim 追加シート名 As String
   Dim 重複 As Integer
   Dim シート As Worksheet
   Dim シート数 As Integer

   Dim 列数 As Integer
   Dim 行数 As Integer
   Dim 文字列 As String
   Dim 銘柄配列() As Variant
   Dim 最終行 As Integer
   Dim 銘柄数 As Integer
   Dim 銘柄カウンタ As Integer
   
   '時系列株価を取得し、Excelシートに書き出すツールです。
   
   開始日時 = Now                ' 開始時刻を変数に格納します。
   
   ' 処理を高速化するため、自動計算停止
   Application.Calculation = xlCalculationManual

   '前回作成したシートがあれば削除
   For Each シート In ThisWorkbook.Worksheets
      If シート.Name <> "テンプレート" And シート.Name <> "指定登録" Then
         'シート名 テンプレート と 指定登録 以外のシートを削除
         Application.DisplayAlerts = False
         シート.Delete
         Application.DisplayAlerts = True
      End If
   Next シート
   
   ThisWorkbook.Worksheets("指定登録").Activate
   URL株式株価Yahooファイナンス = Range("B1").Value
   取得ページ数 = Int(Range("B2").Value / 20 + 0.99)
   最終行 = Cells(ActiveSheet.Rows.Count, 1).End(xlUp).Row
   銘柄数 = 最終行 - 5
   銘柄配列 = Range("A6").Resize(銘柄数, 1)
   SaveFolder = Range("B3").Value
   
   '以上が設定です。ここより下の行はメインプログラムとなります。
   
   Set ファイルシステムオブジェクト = CreateObject("Scripting.FileSystemObject")
   
   If Not ファイルシステムオブジェクト.FolderExists(SaveFolder) Then
       MsgBox "保存先フォルダが存在しません"
       Exit Sub
   End If
   

   Set 正規表現 = New RegExp
   正規表現.Pattern = "(\d{4}年\d{1,2}月\d{1,2}日)</td><td>([\.0-9|,]+)</td><td>([\.0-9|,]+)</td><td>([\.0-9|,]+)</td><td>([\.0-9|,]+)</td><td>([\.0-9|,]+)</td><td>([\.0-9|,]+)"
   正規表現.IgnoreCase = True   '大文字小文字を区分しない
   正規表現.Global = True
   

   For 銘柄カウンタ = 1 To 銘柄数
   
      '株価コードを設定します
      銘柄コード = 銘柄配列(銘柄カウンタ, 1)
   
      出力ファイルパス = ファイルシステムオブジェクト.buildPath(SaveFolder, 銘柄コード & ".txt")
      '構文:object.CreateTextFile(filename[, overwrite[, unicode]]) → ShiftJIS だとエラーになる文字があるため↓
      'http://blog.systemjp.net/entry/2013/04/10/191821 ←教えていただいたサイト
      'http://ameblo.jp/cashtray/entry-11066671774.html ←教えていただいたサイト
      Set キストストリームオブジェクト = ファイルシステムオブジェクト.CreateTextFile(出力ファイルパス, True, True)

      追加シート名初期 = 銘柄コード
      追加シート名 = 追加シート名初期
   
      For 重複 = 1 To 100
      ' 100枚まで追加しても重複しないように追番を設定します。
          For Each シート In Worksheets
              If シート.Name = 追加シート名 Then
                  追加シート名 = 追加シート名初期 & "(" & 重複 & ")"
              End If
          Next シート
      Next 重複
      シート数 = Worksheets.Count
      Worksheets("テンプレート").Copy After:=Worksheets(シート数)
      ActiveSheet.Name = 追加シート名
      
      行数 = 0
      For 取得ページカウンタ = 1 To 取得ページ数
         Call HTML取得(URL結合(銘柄コード, Date - 80 * 取得ページカウンタ, Date, 取得ページカウンタ))
          
         Range("A2").Value = URL結合(銘柄コード, Date - 80 * 取得ページカウンタ, Date, 取得ページカウンタ)
   
         '検証用にHTMLソースを出力
         キストストリームオブジェクト.writeLine HTMLソース

         If InStr(HTMLタイトル, ":") > 0 Then
            Range("A1").Value = Trim(Left(HTMLタイトル, InStr(HTMLタイトル, ":") - 1))
         Else
            Range("A1").Value = HTMLタイトル
         End If

         '1行目から順に、最後の行まで
      
         Set SubMatchesコレクション = 正規表現.Execute(HTMLソース)
         For カウンタ = 0 To SubMatchesコレクション.Count - 1
            行数 = 行数 + 1
            For 列数 = 1 To 7
               Range("A4").Cells(行数, 列数).Value = SubMatchesコレクション.Item(カウンタ).SubMatches(列数 - 1)
            Next 列数
         Next カウンタ
          
         'SubMatches コレクションとは、正規表現のサブマッチ文字列のコレクションです。
         'SubMatches コレクションには、個別のサブマッチ文字列が格納されます。
         'このコレクションは、RegExp オブジェクトの Execute メソッドによってのみ作成可能です。
         'SubMatches コレクションのプロパティは、すべて読み取り専用です。
         '正規表現で検索を実行すると、サブ条件が取得を示すかっこで囲まれている場合にサブマッチ文字列が 0 個以上作成されます。
         'SubMatches コレクションの各項目は、正規表現によって検索および取得される文字列です。
   
      Next 取得ページカウンタ
      
      キストストリームオブジェクト.Close
   
   Next 銘柄カウンタ
   
   ' 自動計算停止解除
   Application.Calculation = xlCalculationAutomatic
   
   終了日時 = Now
   MsgBox "処理時間は、" _
   & Format(終了日時 - 開始日時, "hh時間nn分ss秒") & " でした。"

End Sub



Private Sub HTML取得(url)
   Dim 対象HTMLDocument As HTMLDocument
   Dim HTML文書 As HTMLDocument
   Dim ループ回数 As Integer
   
   Set 対象HTMLDocument = New HTMLDocument

 'URLからHTMLDocumentを取得する
   Set HTML文書 = 対象HTMLDocument.createDocumentFromUrl(url, vbNullString) 'HTML文書をDOMとして取得

   ' ダウンロード待ち
   ループ回数 = 0
   Do While HTML文書.readyState <> "complete"
      DoEvents       ' Sleep しているときに、画面を書き換えできるように、OS に制御を渡す。
      Sleep (100)
      ループ回数 = ループ回数 + 1
      Range("H1").Value = ループ回数
      If ループ回数 > 1000 Then
         MsgBox "サイトのデータ取得に時間がかかっているので、一旦 中断します"
         Exit Sub
      End If
   Loop
   'HTML のタイトル抽出
   HTMLタイトル = HTML文書.Title
   
   'HTML の BODY 抽出
   HTMLソース = HTML文書.body.innerHTML
   HTMLソース = Replace(HTMLソース, vbNewLine, "") 'HTML の改行を削除
   
   Set HTML文書 = Nothing
   Set 対象HTMLDocument = Nothing
   
End Sub


株取引に VBA を使うの目次に戻る Excel VBAの目次に戻る↑ 索引へ↓ トップページに戻る


SMBC日興証券オンライントレード売買注文登録

 株取引で大切なことは、言うまでもありませんが、できるだけ安く仕入れて、できるだけ高く売り抜けることです。
 この可能性を高めるために、私は、ダメ元を含めて、複数の銘柄を、安めの買い値と、そこそこの売り値で、指値登録しています。
 株価は、常に変動しているので、その瞬間風速を把えることができれば、有利な売買ができるからです。

 注:指値の設定には「標準偏差で指値の値を求める」を使っています。

 多数の銘柄を、毎日オンライントレードで間違いなく登録することは、面倒な作業です。

 このため、Excelのシートで指定した、複数の株取引を、SMBC日興証券オンライントレードで注文約定登録するExcelマクロを作りました。
 SMBC日興証券に口座を持っていない方は、VBA で IE にデータ登録する事例として活用下さい。

このマクロをダウンロードできます。→SmbcNikkoEntryVBA01.xls

 サンプル・データを登録済みなので、ボタンを押すだけで、マクロの動作を確認できます。

 正規表現を使うために、参照設定を追加します。

Option Explicit
Option Base 1

   Dim データ配列() As Variant
   Dim 最終行数 As Integer
   Dim 処理行 As Integer
   Dim 対象URL As String
   Dim バージョン As Integer
   Dim IEオブジェクト As Object
   Dim inputタグオブジェクト As Object
   Dim タグオブジェクト As Object
   Dim 入力行 As Integer
   Dim 処理 As String
   Dim Shellオブジェクト As Object
   Dim 開いているIEオブジェクト As Object
   Dim HTMLソース As String
   Dim 開いているURL As String
   Dim 上限値 As Long
   Dim 下限値 As Long
   Dim 売却可能数量 As Long
   Dim 文字列 As String
   Dim 文字配列() As String
   Dim ページ行数 As Integer
   Dim 行文字列 As String
   Dim 行数 As Integer
   Dim 文字列temp As String
   Dim 注文単価 As Long
   Dim HTMLタイトル As String
   Dim 銘柄名 As String
   Dim フォーム数 As Integer
   Dim 開始日時 As Variant
   Dim 終了日時 As Variant

Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
'これで Sleepを使ってミリ秒単位で処理にウェイトを入れることができます。


Sub 日興證券国内株式注文約定登録()

   開始日時 = Now                ' 開始時刻を変数に格納します。

   ThisWorkbook.Worksheets("指定登録").Activate

   Call IEバージョンを知る(バージョン)

   データ配列 = Range("A1").CurrentRegion.Value

   最終行数 = UBound(データ配列)

   'Shell.Applicationオブジェクトの作成
   Set Shellオブジェクト = CreateObject("Shell.Application")

   For 処理行 = 2 To 最終行数 '1行目はヘッダー情報なので、読み飛ばして、2行目からを扱う

      If データ配列(処理行, 2) = "" Then   '銘柄コードが空白の行に到達したら、処理を終る
         Exit For
      End If

      If データ配列(処理行, 1) = True Then 'A列の対象でチェック(True)をした行のみを対象にする
         注文単価 = データ配列(処理行, 6)
         Select Case データ配列(処理行, 4) '売りと買いで、処理が違うので、場合分けする

         '★★★ "売" ★★★ "売 ★★★ "売" ★★★" "売" ★★★
            Case "売"

               対象URL = "https://trade.smbcnikko.co.jp/StockOrderConfirmation/B5C2O0066177/kbodr/uri_odr/hyji?specifyMeig=1&meigCd=00" _
               & データ配列(処理行, 2) & "0000&knrkokbn=0"

               If バージョン > "6" Then

                  'IEオブジェクトの作成(ダミー)
                  Set IEオブジェクト = CreateObject("InternetExplorer.Application")

                  IEオブジェクト.Navigate2 対象URL     '★IE7の場合、既存or新しいウィンドウで表示される
                  If 入力行 = 1 Then
                     IEオブジェクト.Quit               '★IE7の場合、ここで閉じるのはCreateObjectで作成したウィンドウ
                     Set IEオブジェクト = Nothing      '★IE7の場合、いったんオブジェクトをクリア
                     Application.Wait Now + TimeValue("00:00:01")
                  End If

                  処理 = "Shell.ApplicationオブジェクトのWindowオブジェクトからIEオブジェクトを取り出す"
                  '作成されているポイントは、Windowsコレクションの最後の要素

                  Set IEオブジェクト = Shellオブジェクト.Windows.Item(Shellオブジェクト.Windows.Count - 1)
                  'これ以降は、従来と同様の方法で操作が可能
                  With IEオブジェクト
                     .Navigate 対象URL
                     .Visible = True
                  End With

                  Call IE表示待ち
               Else
                  '★IE6以前の場合
                  Set IEオブジェクト = CreateObject("InternetExplorer.Application")

                  With IEオブジェクト
                     .Navigate 対象URL
                     .Visible = True
                  End With

                  Call IE表示待ち

               End If

               '前回のメッセージを削除
               Range("H1").Cells(処理行, 1).Value = ""

               'タイトルを取得
               HTMLタイトル = IEオブジェクト.Document.Title
               If InStr(HTMLタイトル, "売り注文 エラー") > 0 Then
                  Range("H1").Cells(処理行, 1).Value _
                  = "売り注文 エラー"
                  IEオブジェクト.Quit
                  GoTo 次の処理行へ
               End If

               '表示したページの<BODY>部のHTMLを取得し、イミディエイト・ウインドウに表示
               HTMLソース = IEオブジェクト.Document.body.innerHTML
               Debug.Print HTMLソース

               '1行ずつに分割
               Erase 文字配列
               文字配列 = Split(HTMLソース, vbNewLine)

               '全体行数を取得
               ページ行数 = UBound(文字配列)

               If ページ行数 = 0 Then 'vbNewLine で行分割できなかった場合
                  '1行ずつに分割
                  Erase 文字配列
                  文字配列 = Split(HTMLソース, vbLf)
                  '全体行数を取得
                  ページ行数 = UBound(文字配列)
               End If

               For 行数 = 1 To ページ行数
                  行文字列 = 文字配列(行数)

                  If InStr(行文字列, "ご指定の銘柄は存在しません") > 0 Then
                        Range("H1").Cells(処理行, 1).Value _
                        = "ご指定の銘柄は存在しません"
                        IEオブジェクト.Quit
                        GoTo 次の処理行へ

                  ElseIf InStr(行文字列, "sinkbShitei") > 0 Then
                     銘柄名 = Replace(正規表現で置換("<(.*?)>", 行文字列, ""), " ", "")
                     If データ配列(処理行, 3) = "" Then
                        Range("C1").Cells(処理行, 1).Value = 銘柄名 '銘柄の列が空白の場合、銘柄名を表示
                     End If
                  ElseIf InStr(行文字列, "以上") > 0 And InStr(行文字列, "以下") > 0 Then
                     'HTML のタグを削除。カンマ区切りの数値をValで数値変換すると、,より前しか取得しないので、,を外す。
                     文字列 = Replace(正規表現で置換("<(.*?)>", 行文字列, ""), ",", "")

                     文字列temp = Left(文字列, InStr(文字列, "/") - 1)
                     下限値 = Val(Right(文字列temp, Len(文字列temp) - InStrRev(文字列temp, "-")))
                     上限値 = Val(Right(文字列, Len(文字列) - InStr(文字列, "/")))

                     If 下限値 > データ配列(処理行, 6) Then ' 注文単価が、下限値以下
                        注文単価 = 下限値
                        Range("H1").Cells(処理行, 1).Value _
                        = "注文単価" & CStr(データ配列(処理行, 6)) & "が、下限値" & 下限値 & "未満なので、下限値を注文単価にしました。"
                     End If

                  ElseIf InStr(行文字列, "特定口座:") > 0 Then

                     文字列temp = 正規表現で置換("<(.*?)>", 行文字列, "")
                     文字列temp = Replace(文字列temp, "特定口座:", "")
                     文字列temp = Replace(文字列temp, ",", "")
                     売却可能数量 = Val(文字列temp) '特定口座の売却可能数量

                     If データ配列(処理行, 5) > 売却可能数量 Then
                        Range("H1").Cells(処理行, 1).Value _
                        = "注文数量" & CStr(データ配列(処理行, 5)) & "が、売却可能数量" & 売却可能数量 & "以上なので、スキップしました。"
                        IEオブジェクト.Quit
                        GoTo 次の処理行へ
                     End If
                     Exit For
                  End If

               Next 行数

               IEオブジェクト.Document.Forms("frm_chart")("suryo").Value = データ配列(処理行, 5)  '数量
               IEオブジェクト.Document.Forms("frm_chart")("nariSasiKbn").sasi.Click               '指値
               IEオブジェクト.Document.Forms("frm_chart")("kakaku").Value = 注文単価              '注文単価
               IEオブジェクト.Document.Forms("frm_chart")("yukokikan").konsy.Click                '期間指定

               IEオブジェクト.Document.Forms("frm_chart").Submit

               '★★売り注文確認画面★★

               '起動した IE が 必ず 絶対 一番後ろ と決め付けて(プログラマーに絶対は無いだろクソ三流)
               Set 開いているIEオブジェクト = Shellオブジェクト.Windows(Shellオブジェクト.Windows.Count - 1)
               '↑配列が0からなのでカウント-1 一番後ろのWindowをobjIEに代入

               Call IE表示待ち

               開いているURL = 開いているIEオブジェクト.LocationURL

               '表示したページの<BODY>部のHTMLを取得し、イミディエイト・ウインドウに表示
               HTMLソース = 開いているIEオブジェクト.Document.body.innerHTML
               Debug.Print HTMLソース

               'JavaScriptのwindow.document.formsオブジェクト
               'http://freematerial.fc2web.com/ref_js/ref_js_w_d_f.html
               'JavaScript/DOM  ≫  ドキュメント内の要素数と、各要素の情報を取得
               'http://phpjavascriptroom.com/?t=js&p=document_elements
               フォーム数 = 開いているIEオブジェクト.Document.Forms.Length

               ' http://www.ken3.org/cgi-bin/group/vba_ie_form.asp
               For Each タグオブジェクト In 開いているIEオブジェクト.Document.Forms(2) '構成要素を1つ1つ取り出す

                   If タグオブジェクト.Name = "insider" Then 'インサイダーチェックが見つかったか?
                       タグオブジェクト.Checked = True       '.Checked = True で チェックを付ける
                       Exit For                              '探し終わったのでループを抜ける
                   End If
               Next

               'ひこなんのVBAサンプルコード
               ' IE操作_inputタグからalt属性で「検索する」を見つけてクリックする(MSHTML.HTMLImg.altプロパティ)
               'http://www.geocities.jp/samplecode_20130202/Sample/39845502762427578621927533367210465433073247662476393678643923581.html
               For Each inputタグオブジェクト In 開いているIEオブジェクト.Document.all.tags("input")
                  If inputタグオブジェクト.alt = "注文する" Then
                     inputタグオブジェクト.Click
                     Exit For
                  End If
               Next

               開いているIEオブジェクト.Quit

         '★★★ "買" ★★★ "買 ★★★ "買" ★★★" "買" ★★★
            Case "買"

               対象URL = "https://trade.smbcnikko.co.jp/StockOrderConfirmation/215932/kbodr/kai_odr/hyji?specifyMeig=1&meigCd=00" _
               & データ配列(処理行, 2) & "0000"

               Set IEオブジェクト = CreateObject("InternetExplorer.Application")

               If バージョン > "6" Then
                  IEオブジェクト.Navigate2 対象URL     '★IE7の場合、既存or新しいウィンドウで表示される
                  If 入力行 = 1 Then
                     IEオブジェクト.Quit               '★IE7の場合、ここで閉じるのはCreateObjectで作成したウィンドウ
                     Set IEオブジェクト = Nothing      '★IE7の場合、いったんオブジェクトをクリア
                     Application.Wait Now + TimeValue("00:00:01")
                  End If

                  処理 = "Shell.ApplicationオブジェクトのWindowオブジェクトからIEオブジェクトを取り出す"
                       '作成されているポイントは、Windowsコレクションの最後の要素

                  Set IEオブジェクト = Shellオブジェクト.Windows.Item(Shellオブジェクト.Windows.Count - 1)
                  'これ以降は、従来と同様の方法で操作が可能
                  With IEオブジェクト
                     .Navigate 対象URL
                     .Visible = True
                  End With

                  Call IE表示待ち

               Else
                  '★IE6以前の場合
                  Set IEオブジェクト = CreateObject("InternetExplorer.Application")

                  With IEオブジェクト
                     .Navigate 対象URL
                     .Visible = True
                  End With

                  Call IE表示待ち
               End If

               '前回のメッセージを削除
               Range("H1").Cells(処理行, 1).Value = ""

               'タイトルを取得
               HTMLタイトル = IEオブジェクト.Document.Title
               If InStr(HTMLタイトル, "買い注文 エラー") > 0 Then
                  Range("H1").Cells(処理行, 1).Value _
                  = "買い注文 エラー"
                  IEオブジェクト.Quit
                  GoTo 次の処理行へ
               End If

               '表示したページの<BODY>部のHTMLを取得し、イミディエイト・ウインドウに表示
               HTMLソース = IEオブジェクト.Document.body.innerHTML
               Debug.Print HTMLソース

               '1行ずつに分割
               Erase 文字配列
               文字配列 = Split(HTMLソース, vbNewLine)

               '全体行数を取得
               ページ行数 = UBound(文字配列)

               If ページ行数 = 0 Then 'vbNewLine で行分割できなかった場合
                  '1行ずつに分割
                  Erase 文字配列
                  文字配列 = Split(HTMLソース, vbLf)
                  '全体行数を取得
                  ページ行数 = UBound(文字配列)
               End If

               For 行数 = 1 To ページ行数
                  行文字列 = 文字配列(行数)

                  If InStr(行文字列, "sinkbShitei") > 0 Then
                     銘柄名 = Replace(正規表現で置換("<(.*?)>", 行文字列, ""), " ", "")
                     If データ配列(処理行, 3) = "" Then
                        Range("C1").Cells(処理行, 1).Value = 銘柄名 '銘柄の列が空白の場合、銘柄名を表示
                     End If

                  ElseIf InStr(行文字列, "以上") > 0 And InStr(行文字列, "以下") > 0 Then
                     'HTML のタグを削除。カンマ区切りの数値をValで数値変換すると、,より前しか取得しないので、,を外す。
                     文字列 = Replace(正規表現で置換("<(.*?)>", 行文字列, ""), ",", "")
                     文字列temp = Left(文字列, InStr(文字列, "/") - 1)
                     下限値 = Val(Right(文字列temp, Len(文字列temp) - InStrRev(文字列temp, "-")))
                     上限値 = Val(Right(文字列, Len(文字列) - InStr(文字列, "/")))

                     If 上限値 > 0 And 上限値 < データ配列(処理行, 6) Then ' 注文単価が、上限値以上
                        注文単価 = 上限値
                        Range("H1").Cells(処理行, 1).Value _
                        = "注文単価" & CStr(データ配列(処理行, 6)) & "が、上限値" & 上限値 & "以上なので、上限値を注文単価にしました。"
                     End If
                     Exit For
                  End If

               Next 行数

               IEオブジェクト.Document.Forms("frm_chart")("suryo").Value = データ配列(処理行, 5)  '数量
               IEオブジェクト.Document.Forms("frm_chart")("nariSasiKbn").sasi.Click               '指値
               IEオブジェクト.Document.Forms("frm_chart")("kakaku").Value = 注文単価              '注文単価
               IEオブジェクト.Document.Forms("frm_chart")("yukokikan").konsy.Click                '期間指定

               IEオブジェクト.Document.Forms("frm_chart").Submit

               '★★買い注文確認画面★★

               '起動した IE が 必ず 絶対 一番後ろ と決め付けて(プログラマーに絶対は無いだろクソ三流)
               Set 開いているIEオブジェクト = Shellオブジェクト.Windows(Shellオブジェクト.Windows.Count - 1)
               '↑配列が0からなのでカウント-1 一番後ろのWindowをobjIEに代入

               Call IE表示待ち

               開いているURL = 開いているIEオブジェクト.LocationURL

               '表示したページの<BODY>部のHTMLを取得し、イミディエイト・ウインドウに表示
               HTMLソース = 開いているIEオブジェクト.Document.body.innerHTML
               Debug.Print HTMLソース

               'JavaScriptのwindow.document.formsオブジェクト
               'http://freematerial.fc2web.com/ref_js/ref_js_w_d_f.html
               'JavaScript/DOM  ≫  ドキュメント内の要素数と、各要素の情報を取得
               'http://phpjavascriptroom.com/?t=js&p=document_elements
               フォーム数 = 開いているIEオブジェクト.Document.Forms.Length

               ' http://www.ken3.org/cgi-bin/group/vba_ie_form.asp
               For Each タグオブジェクト In 開いているIEオブジェクト.Document.Forms(2) '構成要素を1つ1つ取り出す
                   '名前がinsiderのデータを探す
                   If タグオブジェクト.Name = "insider" Then 'インサイダーチェックが見つかったか?
                       タグオブジェクト.Checked = True       '.Checked = True で チェックを付ける
                       Exit For                              '探し終わったのでループを抜ける
                   End If
               Next

               For Each inputタグオブジェクト In 開いているIEオブジェクト.Document.all.tags("input")
                  If inputタグオブジェクト.alt = "注文する" Then
                     inputタグオブジェクト.Click
                     Exit For
                  End If
               Next

               開いているIEオブジェクト.Quit

            Case Else
               MsgBox "売買の指定を認識できません。この行をスキップします。" & vbNewLine _
               & 処理行 & データ配列(処理行, 2) & データ配列(処理行, 3)

         End Select

      End If
次の処理行へ:
   Next 処理行

   Set IEオブジェクト = Nothing
   Set Shellオブジェクト = Nothing   'この変数は 用済みなので、バイバイ

   終了日時 = Now
   MsgBox "処理時間は、" _
   & Format(終了日時 - 開始日時, "hh時間nn分ss秒") & " でした。"

End Sub


  '**********************************************************************
'  インストールされている Internet Explorer のバージョンを調べる
Private Sub IEバージョンを知る(バージョン)
   Dim IEバージョン 'As String
   Dim ファイルシステムオブジェクト 'As Object

   Set ファイルシステムオブジェクト = CreateObject("Scripting.FileSystemObject")

   IEバージョン = ファイルシステムオブジェクト.GetFileVersion _
   ("C:\Program Files\Internet Explorer\IEXPLORE.EXE ")
'  MsgBox IEバージョン

   バージョン = CInt(Left(IEバージョン, InStr(IEバージョン, ".") - 1))

   Set ファイルシステムオブジェクト = Nothing
End Sub


株取引に VBA を使うの目次に戻る Excel VBAの目次に戻る↑ 索引へ↓ トップページに戻る


標準偏差で指値の値を求める

 ここでは、日本経済新聞の株価データで参照できる、「過去25日間の修正後終値」から、移動平均値と標準偏差を求めて、指値の値を求めるマクロを紹介します。
 売値、買値の当日用の、それなりの指値の値を、簡単に設定できます。
 株価変動の大きい銘柄について、有効だと思います。

 「修正後終値」を使う理由は、25日の期間内に、株式分割などで株価のベースが変わったときにも平均値と標準偏差を求めることができるからです。
 例えば、三菱自動車は、2013年7月に、普通株式 10株を 1株の割合で併合しました。
この結果、株価は下記のように不連続になっています。
 日付       終値 修正後終値
 2013/7/29(月)# 1,324 1,324
 2013/7/26(金)  147 1,470

 株価の予測に「標準偏差σ」を使うという発想は、統計を学んだことのある人なら自然に思いつくことです。
 株価の標準偏差の値は、株価シグマ バンドとか、ボリンジャー バンドとも呼ばれています。

 株の達人
ボリンジャーバンドの見方・使い方
http://www.sevendata.co.jp/shihyou/technical/bori.html

 Excelシートで標準偏差を求める部分は、下記を参照させていただきました。
【Speculation life】ボリンジャー・バンド

マクロの特長

 株価の値は、過去の値の母集団とは別物なので、統計手法が当たるとは限りません。
 例えば、何かの状況から、連続的な上昇トレンドや、連続的な下降トレンドに入った場合は、3σを超えて株価が変動することは、不思議なことではありません。

株価推移と正規分布  一つの期間の平均値と標準偏差だけを使うと、右の図のように、下降トレンドに入った負け馬を買って、上昇トレンドの勝ち馬を逃す結果になります。
 このため、このマクロは、
 (1).25日間移動平均値
 (2).24日間の標準偏差(直近の終値を除外:注1)
だけでなく、
 (3).直近3日間の移動平均値
 (4).直近3日間の終値の回帰直線の傾き
 (5).直近(前日)終値
も使っています。

注1:直近の最終日まで標準偏差の計算に使うと、最終日に暴落したとき、その終値により標準偏差が大きくなります。そして、指値にこれを使うと、現実性を失うと考えます。標準偏差に、直近を除く24日間の終値を使うことにより、連続下落の2日目を買いやすくしています。VBA73〜
注2:24日間の終値で得られたσが前日終値の 8%(σ閾率) 以上の場合は、σの換わりに「前日終値の8%(σ閾率)」を使っています。
平均値から、8%(σ閾率) 以上の値の2倍とか3倍を減らした買い指値は、現実的な値にならないからです。
8%x2.5=20% 以上下落したときは、買ってもやむをえないと考えます。
一方、前日の下落率が 8%以上の場合は、σ閾率を 4%に小さくして、連続下落の2日目を買いやすくしています。
(σ閾率は、セルO3とQ3で変更できます。)

1.直近の3日間移動平均値が、25日間移動平均値より高く、かつ直近の3日間の回帰直線の傾きが上向きの場合は、基準が変わったものと判断します。
この場合は、指値を決めるベースに、直近の3日間移動平均値と直近の終値で高い方を使うようにします。
こうして、上昇トレンドを捕捉できるようにしています。
2.下降トレンドの場合も同じです。
直近の3日間移動平均値が、25日間移動平均値より低く、かつ直近の3日間の回帰直線の傾きが下向きの場合は、指値を決めるベースを、直近の3日間移動平均値と直近の終値で低い方を使います。
また、直近(前日)終値が、25日移動平均よりも低くかつ3日移動平均よりも低いときは、直近の終値をベースに使っています。
こうすることで、不良資産を買い込みにくくしています。

 また、下記の機能も、織り込んであります。
3.25日間移動平均値に対して、直近の3日間移動平均値が、一定幅高く、かつ直近の3日間の回帰直線の傾きが下向きの場合は、「売り」サインを表示します。
4.25日間移動平均値に対して、直近の3日間移動平均値が、一定幅低く、かつ直近の3日間の回帰直線の傾きが上向きの場合は、「買い」サインを表示します。
5.「買い」について、下記の条件判断で、「発注登録対象」のチェックを更新します。
 (1).終値が、25日間移動平均値より低く、かつ、直近の3日間移動平均値よりも低い場合、チェックを入れる。

(目的:約定成立の可能性が高いので、限られた MRF の資金を有効に利用できる。)
 (2).保有銘柄について、算出した買い指値が、平均取得単価の 80% 以下の場合、チェックを入れる。
(目的:難平(ナンピン)買いで、平均取得単価を下げる。)
 (3).保有銘柄について、算出した買い指値が、平均取得単価の 80% 以上の場合、チェックを外す。
(目的:塩漬けになる資産を増やさない。)
 (4).株価変動が大きくない銘柄について、「買い」チェックが入っていたら、チェックを外す。
(目的:約定成立の可能性が低い銘柄で、MRF の資金を消耗しない。)

 以上の点は、Bollinger バンドに対する、渡辺マクロの改善アドバンテージです。

このマクロをダウンロードできます。→Bollinger+WatanabeVBA76.xls更新

 サンプル・データを登録済みなので、ボタンを押すだけで、マクロの動作を確認できます。
(初回は、登録銘柄の各シートを追加作成します。このため初回のみ、10分程度かります。
進捗状況は、左下のステータスバーに表示されます。)

 デフォルトでは、買値を-2σに、売値を+1σにしてありますが、お好みで変更できます。
 例えば、買値を-3σに、売値を+2σにすると、安全サイドで、利幅は大きくなります。しかし、売買のチャンスは少なくなります。逆に、幅を狭めると、売買のチャンスは増えますが、利幅は小さくなります。
 標準偏差の平均値に対する比率も考慮する必要があります。私は、標準偏差が平均値の 3%以下の銘柄については、買値を-2.5σにして、利益幅を確保するように設定しています。

 このマクロは、日内変動率の高い銘柄のセルを黄緑色で表示するようにしています。日内変動率の高い銘柄は、バンドの幅を狭めて指値を決めることで、売買のチャンスを増やすことができます。
 これも、渡辺マクロのオリジナルです。

 バージョン17から、価格経歴を保存するようにしました。
振り返って戦略を検討するときに有効です。
 バージョン69から、適時開示速報を取得するようにしました。
「特設注意市場銘柄 (有価証券報告書等の虚偽記載や監査報告書等の不適正意見や、上場契約違反等の上場廃止基準に抵触するおそれがあり、内部管理体制等の改善が必要な状況なのに、まだ上場されているため、投資家が注意すべき銘柄)」などを、あやまって購入しないための情報を確認できます。

 「SMBC日興証券オンライントレード売買注文登録」と組合せて、発注登録まで自動化できます。

 追記:3カ月程出張する機会がありました。
 そのとき、ネットに、光ではなくモバイルルータに格安シムを挿入して接続しました。
 私が契約した格安シムでは通信速度が出なくて、MSXML2.XMLHTTP を使う方法でデータを取得できませんでした。
 このため、IE を使ったバージョンを復活させました。画面表示に失敗したときは、再取得を繰り返すようにして、劣悪な通信環境でも、それなりにデータを取得できました。
このマクロをダウンロードできます。→Bollinger+WatanabeVBA61useIEforLowSpeedConnection.xls


パフォーマンス

直近1年間のパフォーマンス  このマクロを運用した、直近1年間(2016/05〜2017/05)の結果は、右のグラフのとおりです。
 1年前の資産合計(株価+MRF)に対する資産の増加率(年間騰落率、年間収益率)は、5.0% と、定期金利より有利な運用ができました。

 資産(株価+MRF)の 年間騰落率 の 過去12カ月間の平均値は、5.6% でした。
 月別の日経平均株価の終値の対前年同月比と比較したベンチマークでは、7勝5敗となりました。

 譲渡益や配当には、20.315 % も課税(所得税+住民税)されるので、資産は目減りせざるを得ないという言い訳ができます。しかし、凋落(ちょうらく)せずに、順当にスイングする銘柄をうまく選んで、勝率 5割以上を維持したいものです。

2014年の実績2015年の実績2016年の実績
2014年実績 2015年実績 2016年実績
 

使い方

 使い方の想定は、以下の流れです。
夜のくつろぎの時間 (当日の株価が4本値に反映される午後7:50以降) を利用した「デイリー・トレード」を、お楽しみ下さい。

1.マクロを起動して、当日の、各銘柄の株価の4本値データを入手する。
2.夜のニュースや夕刊で、為替変動など環境情報を確認した上で、マクロで表示された指値を評価する。
3.σの倍数や注文数を変更した場合は、株価データを再取得する。(数分で終るので、何度でもできます。)
4.必要なら、銘柄個別のチャートを参照して、トレンド成分の動向を推理して、金額や数量を修正する。
5.発注対象の銘柄だけにチェックが付いていることを確認した上で、日興証券にログオンして、一括登録する。




注:利益を増やすためのマニュアル運用
価格ボード  日中(例えば昼休み)に、各銘柄の約定価格を見る機会が有れば、約定価格が空白の銘柄に注目します。(右図の青枠です)
 約定(売買が成立)した価格(歩み値)が表示されない銘柄は、以下の2つの状況が考えられます。
1.売買注文数が極端に少なくて、価格が寄り付いていない
2.「買い注文」と「売り注文」の一方が他方に比べて極端に多く、売買数が合致しない

自分が「売り注文を出している銘柄」が、売り板注文数に対して、買い板注文数が10倍以上多い場合は、取引時間中に値段がつかず、大引けでストップ高になることが考えられます。
そして、買い注文は翌日も発生して価格はさらに上がることが考えられます。
私は、この場合は、「売り注文」を、日中に取り消して、その日の 8:00 P.M.以降に、当日約定したストップ高の株価で指値注文し直します。
こうすると、翌日の始値で、前日のストップ高の価格より高く売れる可能性が高いからです。

自分が「買い注文を出している銘柄」が、買い板注文数に対して、売り板注文数が10倍以上多い場合は、取引時間中に値段がつかず、大引けでストップ安になることが考えられます。
そして、売り注文は翌日も発生して価格はさらに下がることが考えられます。
私は、この場合は、「買い注文」を、日中に取り消して、その日の 8:00 P.M.以降に、当日約定したストップ安の株価で指値注文し直します。
こうすると、翌日の始値で、前日のストップ安の価格より安く買える可能性が高いからです。

 株約定の仕組み
https://www.rakuten-sec.co.jp/web/domestic/stock/rule/agreed.html

 板読みとは|売買タイミングを正確に知る3つの技術
http://toushi-kyokasho.com/itayomi/



 Planned Happenstance(期待された偶然)という言葉があります。

 偶然は、誰にでも、平等に訪れます。
 このとき、想定して準備していれば、その偶然を、ラッキー・チャンスとして受け止められる可能性が高くなることは、経験でお分かりでしょう。
 Be prepared ! (備えよ常に)
 人事を尽くして天命を待つ
 待てば海路の日和あり

貴方に幸運が訪れますように。

運用上の注意

1.購入時の−2σの価格と、販売時の+1σの価格を比べると、+1σの価格が−2σの価格を下回っていることもあります。
価格の母集団が同一ではなく、平均値が下がっている場合です。
このようなとき、損の出る発注価格を機械的に設定したくない場合は、σの変わりに■を登録します。
こうすると、手入力した価格が維持されて、メッセージ欄に、参考情報として、σを使って計算した価格が表示されます。

2.「売却」注文約定登録時に、注文単価がストップ高の値より高い場合は、ストップ高の価格で「売却」注文約定登録するようになっています。
 この場合は、注文単価の値が取り消し線で消されて、メッセージ欄に登録したストップ高の値が表示されます。
 取得単価を登録しておくと、ストップ高の価格が、取得単価以下の場合は、「売却」注文約定登録しないように、プログラムされています。
 「売却」損が出ないように、安全対策を、組み込んでいるのです。
 損を出しても売りたい「損切り」の場合は、取得単価に取り消しを入れると、取得単価を考慮せずに売り登録をします。

3.「買付」注文約定登録時に、注文単価がストップ安の値より低い場合は、ストップ安の価格で「買付」注文約定登録するようになっています。
 ただし、ストップ安の価格が、25日間移動平均値より高い場合は、「買付」注文登録しないようにプログラムされています。
 急落した割高品を購入しないための、安全対策を、組み込んでいるのです。

4.日本経済新聞の株価データのサイトは、朝 8:30 に、前日比のデータを更新するために一時停止します。
このため、株価取得のマクロは、朝 8:30 をまたがって動かさないようにして下さい。

5.価格変動が大きい銘柄は、新興株です。ただ、こういった銘柄は、上場廃止になる場合があるので、自己責任で判断して下さい。私は一切責任をもてません。
例:2684 ジパング は、平成 25年 7月 16日から平成 25年 9月 10日まで、整理銘柄指定となりましたが、売買はできました。しかし、平成 25年 9月 11日に上場廃止となりました。
 既に保有してしまった株式は、フェニックス銘柄制度 を使って売買することになります。

注:フリードマン「実証的経済学の方法と展開」
 専門的な投機家は平均的に利益を得る一方、次々と入って消えていく素人は定常的に大損をしているのかもしれない。

ナンピン(難平)買い

 ナンピン(難平)買いとは、保有している株価が下がったときに、さらに買い増しをして、平均購入単価を下げることです。
 ナンピン買いは、安い資金投入で、保有株数を増やして、平均購入単価を下げることができます。
 ナンピン買いすれば、買いコストが下がるので、小さい価格上昇でも販売できるチャンスができます。
 機械的に損切りをして損失を出すより、前向きの投機手法と、私は考えています。

 私のマクロは、取得単価に取り消し線を入れていない場合は、損切りせずに、適切な株価でナンピン買いをするように設計してあります。
 株価が下がったときは、「投機家」ではなく「投資家」として、その企業が成長するのを長い目で支援しましょう。

投資とは、投資する先の会社が行う事業やその会社に関わる様々な人によって創造されるほんものの価値や豊かさを蓄えて行くものです。
価値を創造する会社の事業を長きにわたって支えようとする想いが“まごころ”です。
 鎌倉投信の投資哲学より

注意:
 ナンピン買いは、一時的に下がったときに行うと有利になる可能性の高い投資手法ですが、下落トレンドが長期的に継続する場合には、損失をさらに大きくすることにもなりかねません。
 損切りする場合は、譲渡益の金額の内数で損金処理すれば、源泉徴収税の還付を受けることができます。例えば、100万円の含み損を売却で確定させると、約20万円の還付金を受け取ることができます。こうすることで、損失額を、100万円 → 80万円 と圧縮することができます。

呼値

 注文する株価の値は、値段の範囲により、下記のように丸める必要があります。
呼値
ここでは、ユーザ定義関数「呼値」を使って、丸めています。

注:このマクロは、2014年7月22日より適用の、「TOPIX100構成銘柄の呼値の単位縮小」を反映していません。
該当銘柄かどうかを判定するのが、面倒だからです。


正規表現を使う場合は、参照設定を追加します。

Option Explicit
Option Base 1

   Dim データ配列() As Variant
   Dim 過去の4本値配列(25, 7) As Variant
   Dim 標準偏差配列(100, 10) As Variant
   Dim 最終行数 As Integer
   Dim 処理行 As Integer
   Dim 対象URL As String
   Dim 日経URL As String
   Dim バージョン As String
   Dim IEオブジェクト As Object
   Dim 入力行 As Integer
   Dim 処理 As String
   Dim Shellオブジェクト As Object
   Dim 前回最終行 As Integer
   Dim HTMLソース As String
   Dim HTMLタイトル As String
   Dim 開始時刻 As Variant
   Dim 終了時刻 As Variant
   Dim 証券コード索引 As Object        'Scripting.Dictionary オブジェクト
   Dim 証券コード As String
   Dim 処理列 As Integer
   Dim 証券コード数 As Integer


Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
'これで Sleepを使ってミリ秒単位で処理にウェイトを入れることができます。


Sub 日経会社情報で株価標準偏差を取得する()

   開始時刻 = Now() 'マクロの処理時間を計測するため、開始時刻を取得

   '★証券コード索引を作成★
   Set 証券コード索引 = CreateObject("Scripting.Dictionary")  '★連想配列の定義

   ThisWorkbook.Worksheets("指定登録").Activate

   'シート「指定登録」の登録内容を、証券コード順に並び替え
   Range("A11").CurrentRegion.Sort _
      Key1:=Range("B11"), Order1:=xlAscending, _
      Key2:=Range("D11"), Order2:=xlDescending, _
      Header:=xlYes

   Call IEバージョンを知る(バージョン)   'IEのバージョンによって処理が変わるため

   'インターネット画面表示するためのデータを格納
   データ配列 = Range("A11").CurrentRegion.Value
   最終行数 = Cells(ActiveSheet.Rows.Count, 2).End(xlUp).Row '銘柄コードの列をベース
   日経URL = Range("I1").Value

   証券コード数 = 0

   '証券コード毎に、インターネットから情報を取得
   For 処理行 = 2 To 最終行数 - 9

      証券コード = データ配列(処理行, 2)

      If 証券コード索引.Exists(証券コード) = True Then

         '★既に4本値を取得済みの証券コードの場合
         ThisWorkbook.Worksheets("指定登録").Activate

         For 処理列 = 1 To 8
            Range("K1").Cells(処理行 + 9, 処理列).Value _
            = 標準偏差配列(証券コード索引(証券コード), 処理列)
         Next 処理列

         If Range("K1").Cells(処理行 + 9, 8).Value >= 0.05 Then '標準偏差が5%以上を水色に
            Range("K1").Cells(処理行 + 9, 8).Interior.ColorIndex = 8
            Range("C1").Cells(処理行 + 9, 1).Interior.ColorIndex = 8
         Else
            Range("K1").Cells(処理行 + 9, 8).Interior.ColorIndex = xlColorIndexNone
            Range("C1").Cells(処理行 + 9, 1).Interior.ColorIndex = xlColorIndexNone
         End If

         If Range("D1").Cells(処理行 + 9, 1).Value = "買" Then

            Range("F1").Cells(処理行 + 9, 1).Value _
            = 呼値(Int(Range("O1").Cells(処理行 + 9, 1).Value _
            + Range("L1").Cells(処理行 + 9, 1).Value * Val(Range("I1").Cells(処理行 + 9, 1).Value) + 0.5))
            '移動平均値に、標準偏差に指定倍数を掛けたものを加える。四捨五入して整数にする。

         ElseIf Range("D1").Cells(処理行 + 9, 1).Value = "売" Then
            Range("F1").Cells(処理行 + 9, 1).Value _
            = 呼値Int(Range("O1").Cells(処理行 + 9, 1).Value _
            + Range("L1").Cells(処理行 + 9, 1).Value * Val(Range("J1").Cells(処理行 + 9, 1).Value) + 0.5))
         End If

      Else

         'Shell.Applicationオブジェクトの作成
         Set Shellオブジェクト = CreateObject("Shell.Application")
         'IEオブジェクトの作成(ダミー)
         Set IEオブジェクト = CreateObject("InternetExplorer.Application")
         対象URL = 日経URL & 証券コード

         If バージョン > "6" Then
            IEオブジェクト.Navigate2 対象URL '★IE7の場合、既存or新しいウィンドウで表示される
            If 入力行 = 1 Then
               IEオブジェクト.Quit           '★IE7の場合、ここで閉じるのはCreateObjectで作成したウィンドウ
               Set IEオブジェクト = Nothing  '★IE7の場合、いったんオブジェクトをクリア
               Application.Wait Now + TimeValue("00:00:01")
            End If

            処理 = "Shell.ApplicationオブジェクトのWindowオブジェクトからIEオブジェクトを取り出す"
            '作成されているポイントは、Windowsコレクションの最後の要素

            Set IEオブジェクト = Shellオブジェクト.Windows.Item(Shellオブジェクト.Windows.Count - 1)
            'これ以降は、従来と同様の方法で操作が可能
            With IEオブジェクト
               .Navigate 対象URL
               .Visible = True
            End With

            Call IE表示待ち

         Else
            '★IE6以前の場合
            Set IEオブジェクト = CreateObject("InternetExplorer.Application")

            With IEオブジェクト
               .Navigate 対象URL
               .Visible = True
            End With

            Call IE表示待ち

         End If

         HTMLタイトル = ""
         HTMLソース = ""

         Do While HTMLソース = ""
            Sleep (1000)
            HTMLソース = IEオブジェクト.Document.Body.InnerHtml
         Loop

         HTMLタイトル = IEオブジェクト.LocationName

         Call 株価を取得してシートに貼付け 'ブラウザの画面から必要な項目を抽出して貼付けする

         IEオブジェクト.Quit

      End If

   Next 処理行

   'オブジェクトを破棄
   Set IEオブジェクト = Nothing


   'マクロの処理時間を表示して、マクロの終了を伝える
   終了時刻 = Now()
   MsgBox "処理が終了しました。" & Chr(13) _
   & "処理時間は、" & Format(終了時刻 - 開始時刻, "nn分ss秒") & " でした。", vbOKOnly

End Sub


Private Sub 株価を取得してシートに貼付け()
   Dim 文字配列
   Dim ページ行数 As Integer
   Dim 行文字列 As String
   Dim 行数 As Integer
   Dim 行カウンタ As Integer
   Dim 出力行数 As Integer
   Dim 出力列数 As Integer

   Erase 過去の4本値配列

   If Left(HTMLタイトル, 4) <> 証券コード Then '証券コードのデータが存在しない場合
      ThisWorkbook.Worksheets("指定登録").Activate
      Range("K1").Cells(処理行 + 9, 1).Value = "★証券コードの企業が存在しません★"
      ThisWorkbook.Worksheets("過去の4本値").Activate

   Else '証券コードのデータが存在した場合

      証券コード数 = 証券コード数 + 1

      If データ配列(処理行, 3) = "" Then '銘柄名が空白
         ThisWorkbook.Worksheets("指定登録").Activate

         Range("C1").Cells(処理行 + 9, 1).Value _
         = Trim(Mid(HTMLタイトル, 6, InStr(HTMLタイトル, "過去の4本値") - 6 - 1))
      End If

      ThisWorkbook.Worksheets("過去の4本値").Activate
      前回最終行 = Cells(ActiveSheet.Rows.Count, 1).End(xlUp).Row

      '前回取得の銘柄データを削除
      If 前回最終行 > 1 Then 'タイトル行のみの場合は消さないように
         Range("A2:G" & 前回最終行).ClearContents
      End If

      'ブラウザに表示されている内容を、1行ずつに分割
      文字配列 = Split(HTMLソース, vbNewLine)

      '全体行数を取得
      ページ行数 = UBound(文字配列)

      '取得行の絞込みに使うパラメータを初期化
      行カウンタ = 1

      '1行目から順に、最後の行まで
      For 行数 = 300 To ページ行数
         行文字列 = 文字配列(行数)

         'HTML から必要な項目を抽出するためのコーディングの情報を取得
         Debug.Print 行数
         Debug.Print 行文字列 'HTMLの内容を、イミディエイト・ウインドウに表示する

         If 行カウンタ = 1 Then
            If InStr(行文字列, "修正後終値") = 0 Then
               GoTo 次の行へ '「過去の4本値」に到達するまで読み飛ばす
            Else
               行カウンタ = 行数
            End If
         End If

         '検索結果の行数を取得
         If InStr(行文字列, "<TR>") > 0 Then
         ' 行データ開始
               出力行数 = 出力行数 + 1
               出力列数 = 0
         End If

         If 出力行数 > 0 And (InStr(行文字列, "<TD>") > 0 Or InStr(行文字列, "<TH>") > 0) Then
            '列データを配列に格納
            出力列数 = 出力列数 + 1
            If 出力列数 > 16 Then
               Exit For 'Body 読み込みを終わる
            End If

            過去の4本値配列(出力行数, 出力列数) = Trim(Replace(正規表現で置換("<(.*?)>", 行文字列, ""), " ", ""))

         End If

         If 出力行数 > 0 And InStr(行文字列, "</TABLE>") > 0 Then '検索結果のテーブルが終わった
            Exit For 'Body 読み込みを終わる。最後のセルと同一行に</TABLE>があるので、この位置で判定。
         End If
次の行へ:
      Next 行数 'html の Body データを一行ごとに読む

      Range("A2").Resize(25, 7).Value = 過去の4本値配列

      For 処理列 = 1 To 8
         標準偏差配列(証券コード数, 処理列) = Range("I2").Cells(1, 処理列).Value
      Next 処理列

      ThisWorkbook.Worksheets("指定登録").Activate
      For 処理列 = 1 To 8
         Range("K1").Cells(処理行 + 9, 処理列).Value _
         = 標準偏差配列(証券コード数, 処理列)
      Next 処理列

      If Range("K1").Cells(処理行 + 9, 8).Value >= 0.05 Then '標準偏差が5%以上を水色に
         Range("K1").Cells(処理行 + 9, 8).Interior.ColorIndex = 8
         Range("C1").Cells(処理行 + 9, 1).Interior.ColorIndex = 8
      Else
         Range("K1").Cells(処理行 + 9, 8).Interior.ColorIndex = xlColorIndexNone
         Range("C1").Cells(処理行 + 9, 1).Interior.ColorIndex = xlColorIndexNone
      End If


      証券コード索引(証券コード) = 証券コード数  '★取得済み証券コードとして索引に追加

      ThisWorkbook.Worksheets("指定登録").Activate

      If Range("D1").Cells(処理行 + 9, 1).Value = "買" Then
         Range("F1").Cells(処理行 + 9, 1).Value _
         = 呼値Int(Range("O1").Cells(処理行 + 9, 1).Value _
         + Range("L1").Cells(処理行 + 9, 1).Value * Val(Range("I1").Cells(処理行 + 9, 1).Value) + 0.5))
         '移動平均値に、標準偏差に指定倍数を掛けたものを加える。四捨五入して整数にする。

      ElseIf Range("D1").Cells(処理行 + 9, 1).Value = "売" Then
         Range("F1").Cells(処理行 + 9, 1).Value _
         = 呼値Int(Range("O1").Cells(処理行 + 9, 1).Value _
         + Range("L1").Cells(処理行 + 9, 1).Value * Val(Range("J1").Cells(処理行 + 9, 1).Value) + 0.5))
      End If

   End If

End Sub


Private Sub IE表示待ち()

   DoEvents       ' Sleep しているときに、画面を書き換えできるように、OS に制御を渡す。

   Do While IEオブジェクト.Busy = True Or IEオブジェクト.readystate <> 4
      Sleep (1000)
   Loop
   Sleep (2000)

End Sub

Function 呼値(価格 As Long) As Long

   Select Case 価格
      Case Is <= 3000
         呼値 = 価格
      Case Is <= 5000
         呼値 = 5 * Int(価格 / 5 + 0.5)
      Case Is <= 30000
         呼値 = 10 * Int(価格 / 10 + 0.5)
      Case Is <= 50000
         呼値 = 50 * Int(価格 / 50 + 0.5)
      Case Is <= 300000
         呼値 = 100 * Int(価格 / 100 + 0.5)
      Case Is <= 500000
         呼値 = 500 * Int(価格 / 500 + 0.5)
      Case Is <= 3000000
         呼値 = 1000 * Int(価格 / 1000 + 0.5)
      Case Is <= 5000000
         呼値 = 5000 * Int(価格 / 5000 + 0.5)
      Case Is <= 30000000
         呼値 = 10000 * Int(価格 / 10000 + 0.5)
      Case Is <= 50000000
         呼値 = 50000 * Int(価格 / 50000 + 0.5)
      Case Is > 50000000
         呼値 = 100000 * Int(価格 / 100000 + 0.5)
   End Select

End Function



以下は、日経会社情報で適時開示速報を取得する部分です。

Option Explicit

Sub 日経会社情報で適時開示速報を取得する()

   Const 日経URL As String = "http://www.nikkei.com/markets/company/index.aspx?scode="
   
   Dim 文字配列
   Dim ページ行数 As Integer
   Dim 行文字列 As String
   Dim 行数 As Integer
   Dim 行カウンタ As Integer
   Dim 対象URL As String


   対象URL = 日経URL & 証券コード
      
   '★★☆☆★★☆☆Web に接続して株価データを取得する☆☆★★☆☆★★
   HTMLソース = HTML取得(対象URL)
   '★★デバッグ用★★ debug用
   '         Call HTMLソースを出力 :     Stop
   '↑★★☆☆★★☆☆Web に接続して株価データを取得する☆☆★★☆☆★★
   
   'ブラウザに表示されている内容を、1行ずつに分割
   文字配列 = Split(HTMLソース, vbNewLine) '★★★ HTML の改行が vbNewLine の場合に対応 ★★★
   
   '全体行数を取得
   ページ行数 = UBound(文字配列)
   
   If ページ行数 = 0 Then
      Erase 文字配列
      文字配列 = Split(HTMLソース, vbLf) '★★★ HTML の改行が Lf の場合にも対応 ★★★
      '全体行数を取得
      ページ行数 = UBound(文字配列)
   End If
         
   '取得行の絞込みに使うパラメータを初期化
   行カウンタ = 1
   
   '1行目から順に、最後の行まで
   For 行数 = 200 To ページ行数
      行文字列 = 文字配列(行数)
      
      'HTML から必要な項目を抽出するためのコーディングの情報を取得
      Debug.Print 行数
      Debug.Print 行文字列 'HTMLの内容を、イミディエイト・ウインドウに表示する
'         If データ配列(処理行, 1) = 4502 Then Stop
      
      If 行カウンタ = 1 Then
         If InStr(行文字列, "適時開示速報") = 0 Then
            GoTo 次の行へ '「適時開示速報」の行に到達するまで読み飛ばす
         Else
            行カウンタ = 行数
         End If
      End If
         
      If InStr(行文字列, "m-st-top_timely_contents_new js-active m-newsList") > 0 And 行数 > 行カウンタ Then    '適時開示速報
         行数 = 行数 + 2
         行文字列 = 文字配列(行数)
         行文字列 = Replace(行文字列, "&nbsp;", " ")
         行カウンタ = 行数
         
         ThisWorkbook.Worksheets("指定登録").Activate
         Range("AA1").Cells(処理行 + 9, 1).Value = Trim(正規表現で置換("<(.*?)>", 行文字列, ""))
         
         If Range("AA1").Cells(処理行 + 9, 1).Value <> Range("AB1").Cells(処理行 + 9, 1).Value Then
         '適時開示速報が既知で、株価に影響しないと思われる場合は、情報をセルABにコピーしておく。
         'この場合は、セルC1を赤色にはしない。
            
            If InStr(Range("AA1").Cells(処理行 + 9, 1).Value, "自己株式") > 0 _
            And InStr(Range("AA1").Cells(処理行 + 9, 1).Value, "取得終了") > 0 Then
               '問題ないので、色変えしない
            ElseIf InStr(Range("AA1").Cells(処理行 + 9, 1).Value, "注意") > 0 _
               Or InStr(Range("AA1").Cells(処理行 + 9, 1).Value, "監視") > 0 _
               Or InStr(Range("AA1").Cells(処理行 + 9, 1).Value, "銘柄") > 0 _
               Or InStr(Range("AA1").Cells(処理行 + 9, 1).Value, "希望退職") > 0 _
               Or InStr(Range("AA1").Cells(処理行 + 9, 1).Value, "特別損失") > 0 _
               Or InStr(Range("AA1").Cells(処理行 + 9, 1).Value, "終了") > 0 _
               Or InStr(Range("AA1").Cells(処理行 + 9, 1).Value, "子会社化") > 0 _
               Then
               Range("C1").Cells(処理行 + 9, 1).Interior.ColorIndex = 3 '赤色(自動発注の対象外にすべき?)
               Range("AA1").Cells(処理行 + 9, 1).Interior.ColorIndex = 3 '赤色(自動発注の対象外にすべき?)
            End If

         End If
         
         Exit For
         
      End If
次の行へ:
   Next 行数 'html の Body データを一行ごとに読む
   
End Sub



 IE バージョンでブックに取得した時系列データを、MSXML2.XMLHTTP バージョンのブックにコピーするマクロも、参考までに掲示します。
ComplementCells'MissingDataVBA01.xls

Option Explicit

   Dim コピー元ブック As Workbook
   Dim 銘柄コード As String
   
   Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
   'これで Sleepを使ってミリ秒単位で処理にウェイトを入れることができます。
   
Sub ブックの既存の全てのシートについて欠落セルデータをコピー()

   Dim コピー元ブックフルパス

   Dim 対象シート As Worksheet
   Dim 指定セル As Range
   Dim 開始日時     As Variant
   Dim 終了日時 As Variant

   Set 指定セル = Application.InputBox _
       (prompt:="コピー先ブックの、一つのシートの適当なセル、を選択してください" _
       , Title:="コピー先ファイルを指定" _
       , Type:=8)  ' 8は、セル参照 (Range オブジェクト)

   ' 指定セルの Range に対して、.Parent で親オブジェクトWorksheets を、
   ' その.Parent で、Workbooks を、取得します。

   If 指定セル.Parent.Parent.Name = ThisWorkbook.Name Then
       MsgBox "指定されたファイルは、このマクロのファイル自身です。" _
       & Chr(13) & "このままマクロを終了します。"
       Exit Sub
   End If

   開始日時 = Now                ' 開始時刻を変数に格納します。
   Application.DisplayStatusBar = True
   
   ' 処理を高速化するため、自動計算停止
   Application.Calculation = xlCalculationManual
   
   ThisWorkbook.Worksheets("Sheet1").Activate
   コピー元ブックフルパス = ThisWorkbook.Path & "\" & ThisWorkbook.Worksheets("Sheet1").Range("A2").Value
   
   Set コピー元ブック = Workbooks.Open(コピー元ブックフルパス)

   ' シート名を全て取得して、シート補完を実行
   
   指定セル.Parent.Activate

   For Each 対象シート In Worksheets
      銘柄コード = Left(対象シート.Name, 4)
      If IsNumeric(銘柄コード) = True Then
         対象シート.Activate
         Call シート補完
      End If
   Next
   
   コピー元ブック.Close savechanges:=False           '保存せずにブックを閉じる
   
   ' 自動計算停止解除
   Application.Calculation = xlCalculationAutomatic
   
   Application.StatusBar = False
   
   終了日時 = Now
   MsgBox "処理時間は、" _
   & Format(終了日時 - 開始日時, "hh時間nn分ss秒") & " でした。"
   
End Sub


Private Sub シート補完()

   Dim コピー元シート As Worksheet
   Dim 行数 As Integer
   Dim 列数 As Integer
   Dim 最終行 As Integer
   Dim 最終列 As Integer

   DoEvents       ' Sleep しているときに、画面を書き換えできるように、OS に制御を渡す。
   Sleep (1000)
   
   ' コピー元のブックのすべてのワークシートの名前を、For Each〜Nextで調べて照合します。
   For Each コピー元シート In コピー元ブック.Worksheets
      If 銘柄コード = Left(コピー元シート.Name, 4) Then
      
         With コピー元シート.UsedRange
            最終行 = .Find("*", , xlFormulas, , xlByRows, xlPrevious).Row
            最終列 = .Find("*", , xlFormulas, , xlByColumns, xlPrevious).Column
         End With
         
         For 行数 = 1 To 最終行
            Application.StatusBar = コピー元シート.Name & Space(2) & 行数
            
            For 列数 = 1 To 最終列
               If IsError(ActiveSheet.Range("A1").Cells(行数, 列数).Value) = False Then
                  If ActiveSheet.Range("A1").Cells(行数, 列数).Value = "" Then
                     If IsError(コピー元シート.Range("A1").Cells(行数, 列数).Value) = True Then
                     
                        ActiveSheet.Range("A1").Cells(行数, 列数).Value _
                        = コピー元シート.Range("A1").Cells(行数, 列数).Value
                        
                     ElseIf コピー元シート.Range("A1").Cells(行数, 列数).Value <> "" Then
                     
                        ActiveSheet.Range("A1").Cells(行数, 列数).Value _
                        = コピー元シート.Range("A1").Cells(行数, 列数).Value
                        
                     End If
                  End If
               End If
            
            Next 列数
         Next 行数
          
      End If
   Next

End Sub


株取引に VBA を使うの目次に戻る Excel VBAの目次に戻る↑ 索引へ↓ トップページに戻る


Yahoo!ファイナンス コンセンサス予想を取得

 標準偏差で指値の値を求めるとき、安全を見て買値に一律 -2.5σ を設定していました。これだと、なかなか「買い約定」につながりませんでした。
 このため、Yahoo!ファイナンス コンセンサス予想 で、利益が出ていて、増益率がプラス、の場合は、-2σ に狭め、そうでない場合は、-2.5σ に戻す機能を追加しました。(バージョン 72〜)

 このマクロは、該当部分を抽出したものです。
このマクロをダウンロードできます。→Yahoo!FinanceConsensusForecastVBA01.xls
Option Explicit

'2016/12/20:Yahoo のページ仕様変更に対応

Dim HTMLソース As String
      
Sub Yahooファイナンスコンセンサス予想取得()

   Const YahooURL As String = "http://kabuyoho.ifis.co.jp/index.php?id=100&action=tp1&sa=report&bcode="
   
   Dim 文字配列
   Dim ページ行数 As Integer
   Dim 行文字列 As String
   Dim 行数 As Integer

   Dim 対象URL As String

   Dim 正規表現 As RegExp
   Dim 正規表現アナリスト予想 As RegExp
   Dim 正規表現会社予想 As RegExp
   Dim Matchesコレクション As Object
   Dim SubMatchesコレクションアナリスト As Object
   Dim SubMatchesコレクション会社 As Object
   Dim 文字列 As String
   Dim HTMLタイトル As String
   
   Dim 経常利益会社予想 As Single
   Dim 経常利益アナリスト予想 As Single
   Dim 会社予想増益率 As Single
   Dim アナリスト予想増益率 As Single
   
   Dim 開始行 As Integer
   Dim 最終行数 As Integer
   

'*****************************************
   'HTML のタイトル抽出用
   Set 正規表現 = New RegExp
   With 正規表現
      .Pattern = "<title>.*</title>"
      .IgnoreCase = True '大文字小文字を区分しない
      .Global = False
   End With
'*****************************************
   Set 正規表現アナリスト予想 = New RegExp
'   アナリスト予想 (コンセンサス)</span><table><thead><tr><th class="none_left">日付</th><th class="em view_item">2016/12/19</th><th class="view_item">1週前</th><th class="none_right view_item">4週前</th></tr></thead><tbody><tr><th class="none_left">経常利益予想<br>増益率</th><td class="num_center em"><span class="num_b">18,300</span><br><span class="str_red">6.9 %<span></td>
   正規表現アナリスト予想.Pattern = "<span class=""str_b"">アナリスト予想 \(コンセンサス\)</span>.*?>([,\-0-9]+)<.*?>([,\-\.0-9]+) %<"
   正規表現アナリスト予想.Global = True
   
   Set 正規表現会社予想 = New RegExp
'   会社予想</span><table><thead><tr><th class="none_left none_right em">2016/11/07</th></tr></thead><tbody><tr><td class="none_left none_right em num_center"><span class="num_b"><span>21,000</span><br><span class="str_red">22.6 %<span></td>
   正規表現会社予想.Pattern = "<span class=""str_b"">会社予想</span>.*?>([,\-0-9]+)<.*?>([,\-\.0-9]+) %<"
   正規表現会社予想.Global = True
'*****************************************
   
   開始行 = 11 - 9
   最終行数 = Cells(ActiveSheet.Rows.Count, 2).End(xlUp).Row '銘柄コードの列をベース
   
   '証券コード毎に、インターネットから情報を取得
   For 処理行 = 開始行 To 最終行数 - 9
      証券コード = Range("B1").Cells(処理行 + 9, 1).Value
   
'*****************************************

   対象URL = YahooURL & 証券コード
   経常利益会社予想 = 0
   経常利益アナリスト予想 = 0
   会社予想増益率 = 0
   アナリスト予想増益率 = 0
   
   If Range("D1").Cells(処理行 + 9, 1).Value = "買" Then
         
      '★★☆☆★★☆☆Web に接続して経常利益アナリスト予想を取得する☆☆★★☆☆★★
      HTMLソース = HTML取得(対象URL)

      
      Set Matchesコレクション = 正規表現.Execute(HTMLソース)
      
      'HTML のタイトル抽出
      文字列 = Matchesコレクション.Item(0).Value
      HTMLタイトル = Trim(正規表現で置換("<(.*?)>", 文字列, ""))
            
      If InStr(HTMLタイトル, 証券コード) = 0 Then '証券コードのデータが存在しない場合
         GoTo 次の行へ
      End If
      
      'ブラウザに表示されている内容を、正規表現で取得できるように1行にまとめる
      HTMLソース = Replace(HTMLソース, vbTab, "")                          'Tab を除外
      HTMLソース = Replace(HTMLソース, vbLf, "")                           '一旦改行を全て除外
      HTMLソース = Replace(HTMLソース, "</div>", "</div>" & vbCrLf)     '</div>の後に改行を入れる
      
   'デバッグ用 htmlソース書き出し
      '★★デバッグ用★★ debug用
'      If 証券コード = "8031" Then Call HTMLソースを出力
'               Stop
      '↑★★☆☆★★☆☆Web に接続して株価データを取得する☆☆★★☆☆★★

      Set SubMatchesコレクション会社 = 正規表現会社予想.Execute(HTMLソース)
      
      Range("AC1").Cells(処理行 + 9, 1).Value = SubMatchesコレクション会社.Item(0).SubMatches(0)
      If Range("AC1").Cells(処理行 + 9, 1).Value <> "--" Then
         経常利益会社予想 = Replace(SubMatchesコレクション会社.Item(0).SubMatches(0), ",", "")
      End If

      Range("AC1").Cells(処理行 + 10, 1).Value = SubMatchesコレクション会社.Item(0).SubMatches(1)
      If Range("AC1").Cells(処理行 + 10, 1).Value <> "--" Then
         会社予想増益率 = Replace(SubMatchesコレクション会社.Item(0).SubMatches(1), ",", "")
      End If


      Set SubMatchesコレクションアナリスト = 正規表現アナリスト予想.Execute(HTMLソース)
      
      Range("AD1").Cells(処理行 + 9, 1).Value = SubMatchesコレクションアナリスト.Item(0).SubMatches(0)
      If Range("AD1").Cells(処理行 + 9, 1).Value <> "--" Then
         経常利益アナリスト予想 = SubMatchesコレクションアナリスト.Item(0).SubMatches(0)
      End If
      
      Range("AD1").Cells(処理行 + 10, 1).Value = SubMatchesコレクションアナリスト.Item(0).SubMatches(1)
      If Range("AD1").Cells(処理行 + 10, 1).Value <> "--" Then
         アナリスト予想増益率 = SubMatchesコレクションアナリスト.Item(0).SubMatches(1)
      End If
      
      '通期予想が黒字で増加している場合は、買いの値を -2σまで狭める。
      If 経常利益アナリスト予想 > 0 And アナリスト予想増益率 > 0 Then
         If Val(Range("J1").Cells(処理行 + 9, 1).Value) < -2 Then
            Range("J1").Cells(処理行 + 9, 1).Value = "-2" & Right(Range("J1").Cells(処理行 + 9, 1).Value, 1)
         End If
'      ElseIf 経常利益会社予想 > 0 And 会社予想増益率 > 0 Then
'         If Val(Range("J1").Cells(処理行 + 9, 1).Value) < -2 Then
'            Range("J1").Cells(処理行 + 9, 1).Value = "-2" & Right(Range("J1").Cells(処理行 + 9, 1).Value, 1)
'         End If
      ElseIf Val(Range("J1").Cells(処理行 + 9, 1).Value) = -2 Then
      '通期予想が赤字かまたは減少している場合は、買いの値を -2σから -2.5σまで広げる。
            Range("J1").Cells(処理行 + 9, 1).Value = "-2.5" & Right(Range("J1").Cells(処理行 + 9, 1).Value, 1)
      End If
      
   End If
'*****************************************

次の行へ:
   Next 処理行
   
   ' 指定ファイルとオブジェクトをCLOSE
   Set 正規表現 = Nothing
   Set 正規表現アナリスト予想 = Nothing
   Set 正規表現会社予想 = Nothing
   Set Matchesコレクション = Nothing
   Set SubMatchesコレクションアナリスト = Nothing
   Set SubMatchesコレクション会社 = Nothing
   
   MsgBox "終了しました"
End Sub



Private Sub HTMLソースを出力()
'プログラムのチェック用として、所得した最後のHTMLソースをテキスト出力しておく

   Dim ファイルシステムオブジェクト As Object
   Dim 出力ファイルパス As String
   Dim キストストリームオブジェクト As Object
   
   Set ファイルシステムオブジェクト = CreateObject("Scripting.FileSystemObject")
   出力ファイルパス = ThisWorkbook.Path & "\" & "HTMLソース.txt"
   
   Set キストストリームオブジェクト = ファイルシステムオブジェクト.CreateTextFile(出力ファイルパス, True, True)
   キストストリームオブジェクト.writeLine HTMLソース

End Sub


株取引に VBA を使うの目次に戻る Excel VBAの目次に戻る↑ 索引へ↓ トップページに戻る

ホームページのトップに戻る