EXCEL VBAで あくせく http://keizann.blog.shinobi.jp/ ja 2022-03-13T08:31:24+09:00 http://keizann.blog.shinobi.jp/-download-/%E4%BF%A1%E7%94%A8%E5%8F%96%E5%BC%95%E3%80%80ver2.4 信用取引　Ver2.4 　本EXCELは、信用取引を行うトレーダーを対象として作成しています。 ご自身が契約しているインターネット証券会社の取引結果を、このEXCEL表で管理する事を目的としています。 　信用取引では保証金と保証金率の関係や持株下落により保証金率が低下していく事など、証券会社の提供画面を見ているだけでは全... 　本EXCELは、信用取引を行うトレーダーを対象として作成しています。
ご自身が契約しているインターネット証券会社の取引結果を、このEXCEL表で管理する事を目的としています。
　信用取引では保証金と保証金率の関係や持株下落により保証金率が低下していく事など、証券会社の提供画面を見ているだけでは全くわかりません。
またどこまで行けば追証がでるのかという不安ばかりで具体的な株価の数値を知る事ができない悩みからこの株富夢士 信用取引を作成しました。
　株価のシュミレーション値を設定する機能があり、株価の設定値を上下に変化させて、保証金率の変化や追証金の発生する株価をあらかじめ知る事ができます。
証券会社のページでは信用買方金利や貸株料は、一括でしか見る事ができませんが、本シートでは毎日変化している信用買方金利や貸株料を注文毎に確認する事ができます。
　
　注意事項：yahooはスクレイピング(Program等を用いて機械的に掲載情報を取得)する事を禁止しました。
　
　
●使い方
　初期設定や手持ち株の登録・手持ち資金の登録などは、添付の信用取引EXCEL説明書を参照してください。
  
　起動時に「マクロが使用できません。セキュリティレベルが高に設定されています」というエラーが発生する場合。
ご使用しているパソコンのEXCELのマクロのセキュリティレベルが、「最高」又は「高」に設定されていますので、下記の手順でセキュリティレベルを、「中」に設定変更してください。
 EXCELのみを起動して、「ツール」→「オプション」を開く。
「セキュリティタブ」を選択して、「マクロセキュリティ」をクリックする。
「セキュリティレベル」タブの中の「中」を選択して「ＯＫ」を押し、「オプション」も「ＯＫ」を押しEXCELを閉じる。
その後は、本EXCELのマクロ起動が可能になります。
  セキュリティ警告「コンテンツの有効化」が表示されたら、必ずクリックしてマクロが使用できる状態にしてください。 
　このソフトはマクロが無効だと動作しません。
本EXCELを起動したときに表示されるウインドウで、「マクロの使用を有効にする」を必ず選択してください。


　信用取引　Ver2.4
　　↓
　






－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－
2022.04.05 　Ver2.4　　信用取引 ver2.4 公開
　　1. 証券取引所の市場名称変更により市場名称修正。
2022.03.12 　Ver2.3　　信用取引 ver2.3 公開
　　1. yahooの仕様変更により終値収集が出来なくなったので修正。
2021.04.19 　Ver2.2　　信用取引 ver2.2  公開
　　1. yahooの仕様変更により情報収集が出来なくなったので修正。
2017.03.31　Ver2.1 　　信用取引 Ver2.1  公開
    1. Yahooの仕様変更により情報収集ができなくなったので修正。 
       接続先URLを変更。
    2. 注文実行時の警告メーッセージがOFFにならない現象を修正。
2016.05.27　Ver2.0 　    信用取引 Ver2.0  公開
    1. 操作性を向上させるために表設計を見直し表示セルを必要最小限に削減。
    2. 警告メッセージの追加。
    3. 手数料・買方金利/貸株料を欄外に移動。
    4. 取扱い説明書作成。
2015.12.16　Ver1.0　　信用取引 Ver1.0 作成
　　1. 信用建注文の管理機能の作成
　　2. 新規建注文時の保証金額と保証金率の表示
　　3. 評価損が保証金に加算され保証金率が低下するしくみを組込み 
　　4. 株価設定によるシュミレーション機能作成
]]> ダウンロード 2022-04-05T10:02:01+09:00 keizann NINJA BLOG keizann http://keizann.blog.shinobi.jp/-download-/%E6%A0%AA%E5%AF%8C%E5%A4%A2%E5%A3%AB-%E3%81%8B%E3%81%B6%E3%81%A8%E3%82%80%E3%81%97-%E3%80%80ver3.2 株富夢士(かぶとむし)　Ver3.2 　本EXCELは、株取引を始めたばかりの初心者の方や、中長期で現物株取引を行うトレーダーを対象として作成しています。 ご自身が契約しているインターネット証券会社の取引結果を、このEXCEL表で管理す事を目的としています。 手数料を含めた平均取得単価の演算や売却益の演算、損益率、税引き残高などを表形式... 　本EXCELは、株取引を始めたばかりの初心者の方や、中長期で現物株取引を行うトレーダーを対象として作成しています。
ご自身が契約しているインターネット証券会社の取引結果を、このEXCEL表で管理す事を目的としています。
手数料を含めた平均取得単価の演算や売却益の演算、損益率、税引き残高などを表形式で管理する事ができます。
このEXCEL表からインターネット証券会社に接続して、直接株式の売買を行う事は対応していません。
デイトレーダー向きではありません。信用取引には対応していません。
　株価情報収集シートは、Yahooファイナンスからリアルタイムで変化する株価をEXCEL表に取り込む事ができます。
収集できる銘柄数に制限はありませんが、収集速度が90～100件/1分程度のためあまり多くすると実用的ではありません。
1000件を設定すると収集時間はおよそ10分ぐらいと考えてください。
　注意事項：yahooはスクレイピング(Program等を用いて機械的に掲載情報を取得)する事を禁止しました。
●使い方
　初期設定や手持ち株の登録・手持ち資金の登録などは、添付の株富夢士説明書を参照してください。
説明書は、手数料をそのつど支払う契約の場合と、定額手数料契約で異なりますので、証券会社との契約により、いずれかを選択してください。
　起動時に「マクロが使用できません。セキュリティレベルが高に設定されています」というエラーが発生する場合。
ご使用しているパソコンのEXCELのマクロのセキュリティレベルが、「最高」又は「高」に設定されていますので、下記の手順でセキュリティレベルを、「中」に設定変更してください。
 EXCELのみを起動して、「ツール」→「オプション」を開く。
「セキュリティタブ」を選択して、「マクロセキュリティ」をクリックする。
「セキュリティレベル」タブの中の「中」を選択して「ＯＫ」を押し、
「オプション」も「ＯＫ」を押しEXCELを閉じる。
その後は、本EXCELのマクロ起動が可能になります。
　セキュリティ警告「コンテンツの有効化」が表示されたら、必ずクリックしてマクロが使用できる状態にしてください。
 
　このソフトはマクロが無効だと動作しません。
本EXCELを起動したときに表示されるウインドウで、「マクロの使用を有効にする」を必ず選択してください。



　株富夢士　Ver3.2
　　↓
 
－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－
 2022.04.05 Ver3.2　　株富夢士(かぶとむし) Ver3.2 公開
　証券取引所の市場名称変更により市場名称修正。　
 2022.03.12 Ver3.1　　株富夢士(かぶとむし) Ver3.1 公開
　Yahooファイナンスの仕様変更により、銘柄名、市場、終値収集が出来なくなったので修正。　
2021.04.10  Ver3.0　　株富夢士(かぶとむし) Ver3.0 公開
　Yahooファイナンスの仕様変更により、全情報収集が出来なくなったので修正。
　日経平均(998407)、TOPIX(998405)は、サポートされなくなったので収集できません。
2017.03.31  Ver2.9　　株富夢士(かぶとむし)　Ver2.9 公開
1. Yahooの仕様変更により情報収集ができなくなったので更新。
   接続先URL部分の修正
2016.05.13  Ver2.8　　株富夢士(かぶとむし)　Ver2.8 公開
1. 収集株価表示にシュミレーション欄を追加
2. 設定欄に損切値欄を追加
3. 警告メッセージを追加(売却・損切・買入)
4. セル表示部を必要最低限にした。手数料欄などは非表示とした。
5. 新VBAコマンドを使用したので、必須ソフトは EXCEL 2007以上のバージョンとした。
2016.04.12  ver2.7　　株富夢士(かぶとむし)　Ver2.7 公開
1. Yahooファイナンスの仕様変更時に、銘柄名・市場欄に大量データが入る事を防止。
2. 従来の設定値は、持株が無いと設定できなかったが、新規に買いたい銘柄でも買入値を設定して監視できる様にした。
3. 株価検索シートでストップ高・ストップ安の出た銘柄は高値/安値が表示されない不具合を修正。　 
4. 株価検索シートの売買サイン欄がEXCEL2010から誤表示する様になった事を修正。
5. 定額手数料処理を、バッチレス処理に統一。
6. NISA対応の説明書を記入。
7. 取引一覧表の証券コードの記入もれ防止機能を追加。
8. 株価の小数点１桁までの対応を行う。
2014.06.11  Ver2.6　　株富夢士(かぶとむし)　Ver2.6 公開
1. Yahooファイナンスの仕様変更により、全部の情報収集ができなく
　 なったための修正。
2014.05.21  Ver2.5　　株富夢士(かぶとむし) Ver2.5 公開 
1. Yahooファイナンスの仕様変更により、「市場」情報が収集できなく
　 なったため修正。
2014.04.25   Ver2.4　　株富夢士(かぶとむし) Ver2.4 公開 
1. Yahooファイナンスの仕様変更により、1株利益(EPS)、1株資産(BPS)が
　 収集できなくなったため更新。
2. 株価情報収集シートの、年初来安値・年初来高値のデータが
　 安値更新・高値更新時に０になる不具合を修正。
3. 株富夢士のプログラムを、株価情報収集シートの記述と合わせる。
2014.03.15　　Ver2.3　　株富夢士(かぶとむし) Ver2.3 公開 
1. 株価情報収集シートに、株価収益率(PER)、資産倍率(PBR)、1株利益(EPS)、
1株資産(BPS)、１株配当の収集機能を追加。
2. 収集時間が長くなったので、キャンセルボタンを追加。
3. 株価収集件数の最大を上場株式全件(9000件)に変更。
2012.08.03   Ver2.2　　株富夢士(かぶとむし) Ver2.2 公開
1. Yahoo ファイナンスがリアルタイム株価に更新になった。
　 これにより、Home-pageが変更となったため、以前のバージョンでは、
　 情報収集ができなくなった。
2012.02.27  Ver2.1　　株富夢士(かぶとむし) Ver2.1 公開
1. 株価収集ボタンで取引一覧表の銘柄名・市場をYahooから取得する様に変更。
2. 買入れ時の資産一覧表への追加処理の変更。
2011.10.10  Ver2.0　　株富夢士(かぶとむし) Ver2.0 公開    
1. Yahoo ファイナンスより、株価情報の収集機能を追加。
2. 手数料をそのつど支払い方式と定額手数料の２種類に分割して、
　 定額手数料処理マクロを新規作成。
   定額手数料処理に、証券会社バッチ処理とバッチレス処理を作成。
3. 定額手数料契約のために、バッチ処理ボタンを追加。
4. 初期設定時の持ち株登録時に、取引一覧表から資産一覧表へ書き込む処理を追加。
5. 株価収集ボタンで資産一覧表の銘柄名を取引一覧表にコピーする機能を追加。
6. 行クリア処理を追加。
7. 株価検索シートのマクロの銘柄登録上限値を600件に変更。
2007.03.30　Ver1.0　　株富夢士(かぶとむし) Ver1.0 公開
]]> ダウンロード 2022-04-05T09:56:00+09:00 keizann NINJA BLOG keizann http://keizann.blog.shinobi.jp/-download-/%E6%A0%AA%E4%BE%A1%E5%8F%8E%E9%9B%86%20ver1.8 株価収集 Ver1.8 Yahooファイナンスに接続して、株価情報をEXCEL表に取り込む事ができます。 銘柄毎に、銘柄名・市場・単元株・始値・高値・安値・終値・前日比・出来高 ・年初来安値・年初来高値・株価収益率(PER)・純資産倍率(PBR)・１株利益(EPS) ・１株株主資産(BPS)・１株配当・最低購入金額などのデ... 銘柄毎に、銘柄名・市場・単元株・始値・高値・安値・終値・前日比・出来高
・年初来安値・年初来高値・株価収益率(PER)・純資産倍率(PBR)・１株利益(EPS)
・１株株主資産(BPS)・１株配当・最低購入金額などのデータを収集します。
収集したい銘柄の証券コードを記入して、株価収集ボタンを押せば、
Yahooファイナンスから情報を収集してくれます。
証券コードの登録件数に制限は設けていませんが、１件あたりの収集に
約0.5秒から1.0秒かかるので、あまり多すぎると実用的ではありません。
おおよその目安として、100件/1分程度で考えてください。

　注意事項：yahooはスクレイピング(Program等を用いて機械的に掲載情報を取得)する事を禁止しました。



株価情報収集 Ver1.8
             ↓　　
 


2022.04.05 Ver1.8公開
　証券取引所の市場名称変更により、市場名称修正。
2022.03.12 Ver1.7公開
　yahooファイナンスの仕様変更により終値の収集が出来なくなったので修正。
2021.04.25  Ver1.6公開
　Yahooファイナンスの仕様変更により情報収集ができなくなったので修正。
2017.4.01　Ver1.5公開
　Yahooファイナンスの仕様変更により情報収集ができなくなったので修正。
　接続先URLの変更。
2016.4.12 Ver1.4公開
　Office2013より売買サインの表示が誤表示する様になったので修正。
　ストップ高/ストップ安が出た銘柄の高値/安値がゼロになる不具合を修正。
2014.6.12 Ver1.3公開
　Yahooファイナンスの仕様変更により、全情報が収集できなくなったので修正
2014.5.21   Ver1.2公開
　Yahooファイナンスの仕様変更により「市場」が取得できなくなったので修正。
2014.4.25　Ver1.1公開
　Yahooファイナンスの仕様変更により、１株利益(EPS)、１株株主資産(BPS)が
　収集できなくなったので修正。
2014.4.05　Ver1.0公開]]> ダウンロード 2022-04-05T09:45:58+09:00 keizann NINJA BLOG keizann http://keizann.blog.shinobi.jp/-yahoovba-/yahoo%E3%83%95%E3%82%A1%E3%82%A4%E3%83%8A%E3%83%B3%E3%82%B9%E3%81%8B%E3%82%89%E6%99%82%E7%B3%BB%E5%88%97%E3%83%87%E3%83%BC%E3%82%BF%E3%81%AE%E5%8F%96%E5%BE%97 Yahooファイナンスから時系列データの各項目取得 Yahooファイナンスの時系列データページ 赤で囲んだ部分が収集情報の各項目 Yahooファイナンスから時系列情報を受け取って比較用のcmpTextを作成 した後、個々の数値情報を抜き取る処理です。 ここでは、各銘柄の時系列情報のページから４日分を抜き取っています。 Yahooファイナンスの時系列... Yahooファイナンスの時系列データページ
赤で囲んだ部分が収集情報の各項目

Yahooファイナンスから時系列情報を受け取って比較用のcmpTextを作成
した後、個々の数値情報を抜き取る処理です。
ここでは、各銘柄の時系列情報のページから４日分を抜き取っています。
Yahooファイナンスの時系列情報ページは、PM7:00以降になると、
本日分の情報が、最新情報として反映されます。
このため、本日＋過去３日分＝４日分を収集しています。

－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－
Dim syCode     As Integer
Dim strText    As String
Dim wRow       As Integer
Dim cKAZU      As Integer
Dim dKAZU      As Integer
Dim jData    As Variant
Dim kData    As Variant
Dim kabD     As Variant
Dim kabNx    As Variant
Dim clmU     As Integer

 If syCode = Cells(wRow,4) Then
    Cells(wRow, 4).Select
  '【銘柄名】　取得
     strText = GetText(cmpText, "<meta charset", "</head>")
     strText = GetText(strText, "<title>", "【")
     strText = Left(strText, 16)    '先頭より16文字を抜き取り
     Cells(wRow,3) = strText

  '【市場】　取得
     strText = GetText(cmpText, "<main class", "</main")
     strText = GetText(strText, "<section class", "</header>")
     strText = GetText(strText, "<div class=", "<header class")
     If InStr(1, strText, "button type") > 0 Then
        If InStr(1, strText, "東証1部") > 0 Then
                      strText = "東証1部"
        ElseIf InStr(1, strText, "東証2部") > 0 Then
                      strText = "東証2部"
        ElseIf InStr(1, strText, "東証JQS") > 0 Then
                      strText = "東証JQS"
        ElseIf InStr(1, strText, "東証JQG") > 0 Then
                      strText = "東証JQG"
        End If
    Else
        strText = GetText(strText, "<span class", "<div id=")
        strText = GetText(strText, ">", "</span>")
    End If
             Cells(wRow,5) = strText

'   If Cells(wRow,4) = 998407 Or Cells(wRow,4) = 998405 Then
'      strText = GetText(cmpText, ">終値</th>" & Chr(10) & "</tr>", "</table>")
'   Else
'      strText = GetText(cmpText, "調整後終値*</th>" & Chr(10) & "</tr>", "</table>")
'   End If
'       strText = WorksheetFunction.Clean(strText)
'       strText = Replace(strText, "<tr>", "", 1)
'       strText = Replace(strText, "<td>", "", 1)
'       jData = Split(strText, "</tr>", , vbTextCompare)
'   For cKAZU = LBound(jData) To 3       　　　　　   '4日分のデータを取得
'       kData = jData(cKAZU)
'       kabD = Split(kData, "</td>", , vbTextCompare)
'     For dKAZU = 1 To 6                           '日付を除いた６項目データを取得
'         kabNx = kabD(dKAZU)
'         clmU = 5 + (cKAZU * 6) + dKAZU
'         Cells(wRow, clmU) = kabNx
'     Next
'   Next
' Else
'     For cKAZU = 5 To 29
'        Cells(wRow, cKAZU).ClearContents
'     Next
'        Cells(wRow, 3).ClearContents
' End If
End Sub
－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－
 Public Function GetText(prmAllText As String, prmStrText, prmEndText)
    Dim wStrNo      As Long
    Dim wEndNo      As Long
    wStrNo = InStr(1, prmAllText, prmStrText) + Len(prmStrText)
    wEndNo = InStr(wStrNo, prmAllText, prmEndText)
    GetText = Mid$(prmAllText, wStrNo, wEndNo - wStrNo)
 End Function
－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－

2022.03.12
　Yahooファイナンスの仕様変更により銘柄名・市場が収集出来なくなったので修正。
2021.04.25
　Yahooファイナンスの仕様変更により修正。
　日経平均；998407、TOPIX；998405はサービスされなくなりましたので表示できません。
2014.5.21
　Yahooファイナンスの仕様変更により、「市場」情報が収集できなくなったので修正。

 

]]> Yahoo VBA接続 2022-03-13T17:00:00+09:00 keizann NINJA BLOG keizann http://keizann.blog.shinobi.jp/-yahoovba-/%E6%8E%A5%E7%B6%9A%E6%99%82%E9%96%93%E6%B8%AC%E5%AE%9A 接続時間測定 Yahooファイナンスからデータを取得する時の応答時間を計測してみました。 時間計測には、Timer関数を使用します。 Timer関数は、午前０時から経過した秒数を表す単精度浮動小数点数型の 値を返しますので、Yahooファイナンスの接続前と応答テキストの受信後に 入れて掛かった時間を計測します。 ... Yahooファイナンスからデータを取得する時の応答時間を計測してみました。
時間計測には、Timer関数を使用します。
Timer関数は、午前０時から経過した秒数を表す単精度浮動小数点数型の
値を返しますので、Yahooファイナンスの接続前と応答テキストの受信後に
入れて掛かった時間を計測します。

Private Sub Sample ()
Dim oHttp      As Object
Dim strURI     As String
Dim syCode     As String
Dim cmpText    As String
Dim StTim  As  String
Dim EdTim  As  String

 Set oHttp = CreateObject("MSXML2.XMLHTTP")
  StTim = Timer
'－－－－－－－－－－－－－－－－－株価情報検索－－－－－－－－－－－－－
   With oHttp
     strURI = "https://finance.yahoo.co.jp/quote/" & Cells(wRow,4)
                .Open "GET", strURI, False
                .setRequestHeader "If-Modified-Since", "Thu, 01 Jun 1970 00:00:00 GMT"
                .send
    syCode = GetText(.responsetext, "【", "】")
   cmpText = GetText(.responsetext, "<head>", "<footer>")
  End With
'－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－ 
   EdTim = Timer
  Msgbox "処理時間は、" & EdTim - StTim & "秒です。"
End Sub

自宅の回線はＢフレッツ光で、屋内はBUFFALOの無線LAN(Air Station
WZR-450HP-C) が付いています。無線LAN親機は1階で子機は2階に
ありますが、転送速度は 20MB以上が出ており、回線関係の遅延は
無視できる範囲とします。
測定は平日のYahooのアクセスが少ない朝の7:00過ぎに行いました。
測定結果
　　1回目：0.4099秒
　　2回目：0.4900秒
　　3回目：0.5199秒
　　4回目：3.3400秒
　　5回目：0.4500秒

計測してみると、0.4秒代が多く途中で3.34秒が１回入っています。
この結果からみると、1件あたりの平均情報収集時間は、0.5秒程度と
みた方が無難でしょう。
実際に1000件のデータを収集してみると、約９分かかっています。
ではインターネットの混雑状況は、時間帯により違うため計測時間が
変わるのではないかと予測して時間帯を変えて測定してみました。

時間帯別測定結果
1.　   7:00～　：8分50秒
2.     14:30～　：9分27秒
3.　 19:30～　：8分45秒　　　
4.　 21:00～　：8分40秒

結果からみると、インターネットの混雑状況による測定時間の
変化はほとんどないとみてよいでしょう。



2021.04.25  Yahooの仕様変更により情報収集ができなくなったので修正。

2017.04.01　Yahooの仕様変更により情報収集ができなくなったので修正。
　　　　　　接続先URLの変更。

]]> Yahoo VBA接続 2022-03-13T17:00:00+09:00 keizann NINJA BLOG keizann http://keizann.blog.shinobi.jp/-yahoovba-/yahoo%E3%83%95%E3%82%A1%E3%82%A4%E3%83%8A%E3%83%B3%E3%82%B9%E3%81%8B%E3%82%89%E6%A0%AA%E4%BE%A1%E6%83%85%E5%A0%B1%E3%81%AE%E5%8F%96%E5%BE%97 Yahooファイナンスから株価詳細情報の各項目取得 Yahooファイナンスのトヨタ自動車のページ 赤で囲んだ部分が収集する情報詳細の各項目部分。 Yahooファイナンスに接続して、各銘柄毎の株価情報を受け取って、比較用の cmpTextを作成後に、個々の数値情報を抜き取る処理です。 Yahooファイナンスのページからリアルタイムに更新されている株... Yahooファイナンスのトヨタ自動車のページ
赤で囲んだ部分が収集する情報詳細の各項目部分。


Yahooファイナンスに接続して、各銘柄毎の株価情報を受け取って、比較用の
cmpTextを作成後に、個々の数値情報を抜き取る処理です。
Yahooファイナンスのページからリアルタイムに更新されている株価詳細情報と
参考指標(１株配当・PER・PBR・EPS・BPS)を収集します。
この部分はYahooファイナンスのページデザインの変更が行われた場合には
その日から収集ができなくなってしまいます。

  If syCode = Cells(wRow,4) Then
    Cells(wRow, 4).Select
    '【銘柄名】取得
         strText = GetText(cmpText, "<meta charset=", "</head>")
         strText = GetText(strText, "<title>", "【")
         strText = Left(strText, 16)    '先頭より16文字を抜き取り
         Cells(wRow,3) = strText
    '【市場】取得
         strText = GetText(cmpText, "<main class", "</main")
         strText = GetText(strText, "<section class", "</header>")
         strText = GetText(strText, "<div class=","<hearder class")
    If InStr(1, strText, "button type") > 0 Then
        If InStr(1, strText, "東証1部") > 0 Then
                      strText = "東証1部"
        ElseIf InStr(1, strText, "東証2部") > 0 Then
                      strText = "東証2部"
        ElseIf InStr(1, strText, "東証JQS") > 0 Then
                      strText = "東証JQS"
        ElseIf InStr(1, strText, "東証JQG") > 0 Then
                      strText = "東証JQG"
        End If
    Else
        strText = GetText(strText, "<span class","<div id=")
        strText = GetText(strText, ">","</span>")
    End If
     Cells(wRow,5) = strText

' 【単元株数】取得
     
    strText = GetText(cmpText, ">単元株数<", "</dl></li>")
    strText = GetText(strText, "_11kV6f2G"">", "</span>")

         If IsNumeric(strText) = False Then
             strText = ""
         End If
     Cells(wRow,7) = strText

' 【始値】取得
     strText = GetText(cmpText, ">始値<", "</dl></li>")
     strText = GetText(strText, "_11kV6f2G"">", "</span>")
          If IsNumeric(strText) = False Then
              strText = "　　 -"
          End If
     Cells(wRow,8) = strText

' 【高値】取得

     strText = GetText(cmpText, ">高値<", "</dl></li>")
     strText = GetText(strText, "_11kV6f2G"">", "</span>")
          If IsNumeric(strText) = False Then
              strText = "　　 -"
          End If
     Cells(wRow,9) = strText

' 【安値】取得

     strText = GetText(cmpText, ">安値<", "</dl></li>")
     strText = GetText(strText, "_11kV6f2G"">", "</span>")
          If IsNumeric(strText) = False Then
              strText = "　　 -"
          End If
     Cells(wRow,10) = strText

' 【終値】取得
      strText = GetText(cmpText, "<main class", "</main>")
      strText = GetText(strText, "<header class", "</header>")
      strText = GetText(strText, "_3rXWJKZF", "</span></span></div>")
      strText = GetText(strtxt, ">","</span>")   
      If IsNumeric(strText) = False Then
              strText = 0
       Else
      Cells(wRow,11) = strText
       End if
' 【前日比】取得
       strText = GetText(cmpText, ">前日比<", "</dd></dl>")
       strText = GetText(strText, "_3rXWJKZF"">", "</span>")
           If IsNumeric(strText) = False Then
               strText = 0
           End If
       Cells(wRow,12) = strText

' 【出来高】取得
        strText = GetText(cmpText, ">出来高<", "</dl></li>")
        strText = GetText(strText, "_11kV6f2G"">", "</span>")
            If IsNumeric(strText) = False Then
                strText = 0
            End If
        Cells(wRow,13) = strText

' 【年初来安値】取得
         strText = GetText(cmpText, ">年初来安値<", "</dl></li>")
         strText = Replace(strText, ">更新</span>", "", 1)              '更新の文字削除
         strText = GetText(strText, "_11kV6f2G"">", "</span>")
             If IsNumeric(strText) = False Then
                 strText = "　　！"
             End If
         Cells(wRow,14) = strText

' 【年初来高値】取得
　      strText = GetText(cmpText, ">年初来高値<", "</dl></li>")
          strText = Replace(strText, ">更新</span>", "", 1)              '更新の文字削除
          strText = GetText(strText, "_11kV6f2G"">", "</span>")
              If IsNumeric(strText) = False Then
                  strText = "　　！"
              End If
         Cells(wRow,15) = strText
'【EPS】取得
         strText = GetText(cmpText, ">EPS<", "</dl></li>")
         strText = GetText(strText, "<dd class", "</span></dd>")
         strText = GetText(strText, "_11kV6f2G"">", "</span>")
             If IsNumeric(strText) = False Then
                 strText = "　　 -"
             End If
         Cells(wRow,18) = strText
' 【PER】取得
          strText = GetText(cmpText, ">PER<", "</dl></li>")
          strText = GetText(strText, "<dd class", "</span></dd>")
          strText = GetText(strText, "_11kV6f2G"">", "</span>")
          '取得したセル内に"---"があった場合でかつ1株利益(EPS)が開示されており値が正の場合
              If IsNumeric(strText) = False Then
                 If wCellB(18) = "　　 -" Or wCellB(18) < 0 Then
                    strText = "　　 -"
                 Else
                    strText = wCellB(11) / wCellB(18)               'PER = 株価÷(EPS) を演算
                 End If
              End If
          Cells(wRow,16) = strText
' 【BPS】取得
          strText = GetText(cmpText, ">BPS<", "</dl></li>")
          strText = GetText(strText, "<dd class", "</span></dd>")
          strText = GetText(strText, "_11kV6f2G"">", "</span>")
              If IsNumeric(strText) = False Then
                  strText = "　　 -"
              End If
         Cells(wRow,19) = strText
' 【PBR】取得
         strText = GetText(cmpText, ">PBR<", "</dl></li>")
         strText = GetText(strText, "<dd class", "</span></dd>")
         strText = GetText(strText, "_11kV6f2G"">", "</span>")
         '取得したセル内に"---"があった場合でかつ1株資産(BPS)が開示されており値が正の場合
             If IsNumeric(strText) = False Then
               If wCellB(19) = "　　 -" Or wCellB(19) < 0 Then
                  strText = "　　 -"
               Else
                  strText = wCellB(11) / wCellB(19)                'PBR = 株価÷(BPS) を演算
               End If
            End If
         Cells(wRow,17) = strText
' 【1株配当】取得
         strText = GetText(cmpText, ">1株配当<", "</dl></li>")
         strText = GetText(strText, "<dd class", "</span></dd>")
         strText = GetText(strText, "_11kV6f2G"">", "</span>")
             If IsNumeric(strText) = False Then
                 strText = "　　 -"
             End If
        Cells(wRow,20) = strText

       Cells(wRow,21) = Cells(wRow,7) * Cells(wRow,11)

 Else
     For cKAZU = 5 To 21
        Cells(wRow, cKAZU).ClearContents
     Next
        Cells(wRow, 3).ClearContents
 End If
－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－
 Public Function GetText(prmAllText As String, prmStrText, prmEndText)
    Dim wStrNo      As Long
    Dim wEndNo      As Long
    wStrNo = InStr(1, prmAllText, prmStrText) + Len(prmStrText)
    wEndNo = InStr(wStrNo, prmAllText, prmEndText)
    GetText = Mid$(prmAllText, wStrNo, wEndNo - wStrNo)
End Function
－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－
Public Function GetValue(prmAllText As String, prmName)
    Dim wIdx1   As Long
    Dim wArray()    As String
    GetValue = ""
    wArray = Split(prmAllText, "</div>", , vbTextCompare)
    For wIdx1 = LBound(wArray) To UBound(wArray)
        If InStr(1, wArray(wIdx1), prmName, vbTextCompare) > 0 Then
            GetValue = GetText(wArray(wIdx1), "<strong>", "</strong>")
        End If
    Next
End Function
－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－

 市場選択は４桁部分に同一証券コードがあるため、市場選択のページがある事を
考慮して います。年初来安値と年初来高値は、安値・高値を更新をした場合に、
数値の前に"更新"の文字が入る事を考慮しています。
１株利益(EPS)を開示しているのに、株価収益率(PER)を開示していない銘柄が
ありますが、これは1株利益(EPS)が開示されており、かつ値が正の場合は
株価から演算できますので、 PER = 株価 ÷ EPS で演算しています。
１株株主資産(BPS)を開示しているのに、純資産倍率(PBR)を開示していない
銘柄がありますが、これは１株株主資産(BPS)が開示されており、かつ値が正の
場合は株価から演算できますので、 PBR = 株価 ÷ BPS で演算しています。


2022.03.12
　yahooファイナンスの仕様変更により銘柄名・市場が収集できなくなったので修正。
2021.04.25
　Yahooファイナンスの仕様変更により情報収集が出来なくなったので修正。
2014.5.21
　Yahooファイナンスの仕様変更により、「市場」情報が収集できなくなったので修正。 
2014.4.25
　Yahooファイナンスの仕様変更により、１株利益(EPS)、１株株主資産(BPS)が
　収集できなくなったので修正。

]]> Yahoo VBA接続 2022-03-13T17:00:00+09:00 keizann NINJA BLOG keizann http://keizann.blog.shinobi.jp/-yahoovba-/yahoo%E3%83%95%E3%82%A1%E3%82%A4%E3%83%8A%E3%83%B3%E3%82%B9%E3%81%8B%E3%82%89%E6%99%82%E7%B3%BB%E5%88%97%E6%83%85%E5%A0%B1%E3%81%AE%E5%8F%96%E5%BE%97 Yahooファイナンスから時系列情報の取得 Yahooファイナンスは、リアルタイムで株価情報を更新しており、 この情報を外部に無料で配信するサービスを行っています。 リアルタイム情報を表示する「詳細情報」のページと、 前日までの情報を表示する「時系列」情報ページがあります。 時系列情報のページからEXCEL VBAで情報を取得するための 記述... Yahooファイナンスは、リアルタイムで株価情報を更新しており、
この情報を外部に無料で配信するサービスを行っています。
リアルタイム情報を表示する「詳細情報」のページと、
前日までの情報を表示する「時系列」情報ページがあります。
時系列情報のページからEXCEL VBAで情報を取得するための
記述を下記に示します。
 
   
 
Private Sub CommandButton1_Click()
On Error GoTo ErrorTrap
Dim oHttp      As Object
Dim strURI     As String
Dim strText    As String
Dim cmpText    As String
Dim syCode     As String
Dim wRow       As Integer
Dim matubi     As Integer

Application.Cursor = xlWait
Set oHttp = CreateObject("MSXML2.XMLHTTP")
matubi = Cells(Rows.Count, 4).End(xlUp).Row 
   wRow = 6
Do Until wRow > matubi
  If (Cells(wRow, 4) >= 1000 And Cells(wRow, 4) <= 9999)  Then
  With oHttp
     strURI = "https://finance.yahoo.co.jp/quote/" & Cells(wRow,4)
        .Open "GET", strURI, False
  '     .setRequestHeader "If-Modified-Since", "Thu, 01 Jun 1970 00:00:00 GMT"
        .send  
     syCode = GetText(.responsetext, "【", "】")
     cmpText = GetText(.responsetext, "<head>", "<footer>")
  End With
   

     －－－cmpTextから時系列データ抜取り処理－－－

 End If
      wRow = wRow + 1
Loop
    Application.Cursor = xlDefault
    Set oHttp = Nothing   
End Sub
－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－
Public Function GetText(prmAllText As String, prmStrText, prmEndText)
    Dim wStrNo      As Long
    Dim wEndNo      As Long     
    wStrNo = InStr(1, prmAllText, prmStrText) + Len(prmStrText)   
    wEndNo = InStr(wStrNo, prmAllText, prmEndText)   
    GetText = Mid$(prmAllText, wStrNo, wEndNo - wStrNo)
End Function
－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－
時系列データの場合は、YahooファイナンスのURLが、"/quote/"
になっている事に気づいてください。
ここでは、EXCEL表の6行目から証券コードの記入が始まっています。
Cells(wRow, 4)は、EXCEL表の４列目に、証券コードを記載している事を示しています。

GetText Fanctionで、Yahooから受取った該当証券コード情報の内、
.responsetext内の<Title>～</title>行にある【】に挟まれた証券コードを
抜き取っています。
Yahooファイナンスの各銘柄データは、１銘柄毎の全体量が100Kbぐらい
ありますので、非力なEXcelの関数で100Kbを１バイト単位に比較して株価
データを抜き取るには、銘柄数が1000件のもなれば処理時間が長くなって
きます。 ここでは、受取ったHTMLデータの個別銘柄情報のすぐ前にある
<head>のタグから、信用取引情報の後ろの<footer>タグ
までの間を切り取って、比較用の cmpTextを作成しています。
抜き取り後のデータ量は、3Kb程度になりました。
Yahooファイナンスからリアルタイム情報を取得する場合は、下記の1行を指定
しないと、最新情報が得られません。この.setRequestHeaderの1行を指定しない
とサーバーに蓄積された古い情報をもってくる様です。
 
しかし、時系列データの場合は、そもそもが蓄積データのため、この1行は
コメントアウトしました。これをコメントアウトすると約15％程度収集速度が、
 向上します。これは、負荷のかかっているリアルタイムサーバに最新データを
要求して応答が返ってくるまでの処理時間が無くなったからだと 思います。

コメントアウトした1行
 .setRequestHeader "If-Modified-Since", "Thu, 01 Jun 1970 00:00:00 GMT"





2021.04.25  Yahooファイナンスの仕様変更により情報収集が出来なくなったので修正。
　998407 ;日経平均株価、998405 ;TOPIXはサービスがなくなったので収集できません。
2017.04.01　Yahooの仕様変更により情報収集ができなくなったので修正。
　　　　　　接続先URLの変更。


]]> Yahoo VBA接続 2022-03-13T17:00:00+09:00 keizann NINJA BLOG keizann http://keizann.blog.shinobi.jp/-yahoovba-/yahoo%E3%83%95%E3%82%A1%E3%82%A4%E3%83%8A%E3%83%B3%E3%82%B9%E3%81%8B%E3%82%89%E6%A0%AA%E4%BE%A1%E8%A9%B3%E7%B4%B0%E6%83%85%E5%A0%B1%E3%82%92%E5%8F%96%E5%BE%97 Yahooファイナンスから株価詳細情報を取得 &amp;nbsp;Yahooファイナンスは、リアルタイムで株価情報を更新しており、 この情報を外部に無料で配信するサービスを行っています。 自分のパソコンからEXCELシートを開いて、EXCEL VBAを起動して Yahooに接続すれば、リアルタイムの株価情報を取得する事ができます。 Yahooファイナン...  Yahooファイナンスは、リアルタイムで株価情報を更新しており、
この情報を外部に無料で配信するサービスを行っています。
自分のパソコンからEXCELシートを開いて、EXCEL VBAを起動して
Yahooに接続すれば、リアルタイムの株価情報を取得する事ができます。
Yahooファイナンスのページは、リアルタイム情報を表示する「詳細情報」の
ページと、前日までの情報を表示する「時系列」情報ページがあります。
「詳細情報」のページは、東証の株価情報を１分以内の遅れで表示しており
このデータを元にして、PERやPBRなどのデータも変化しています。
VBAでYahooファイナンスから情報を取得するための記述は、
下記の様になります
EXCELシートに追加したコマンドボタン１に、Yahooファイナンスから
情報収集する処理を割り付けています。



Private Sub CommandButton1_Click()
On Error GoTo ErrorTrap
Dim oHttp      As Object
Dim strURI     As String
Dim strText    As String
Dim cmpText    As String
Dim syCode     As String
Dim wRow       As Integer
Dim matubi     As Integer

Application.Cursor = xlWait                   
Set oHttp = CreateObject("MSXML2.XMLHTTP")    
matubi = Cells(Rows.Count, 4).End(xlUp).Row   
   wRow = 6
Do Until wRow > matubi
  If (Cells(wRow, 4) >= 1000 And Cells(wRow, 4) <= 9999)  Then
  With oHttp
    strURI = "https://finance.yahoo.co.jp/quote/" & Cells(wRow, 4)
        .Open "GET", strURI, False
        .setRequestHeader "If-Modified-Since", "Thu, 01 Jun 1970 00:00:00 GMT"
        .send
     syCode = GetText(.responsetext, "【", "】")
     cmpText = GetText(.responsetext, "<head>", "<footer>")
  End With

　　---　cmpTextから株価データの抜き取り処理。---　

   End If
           wRow = wRow + 1
Loop
    Application.Cursor = xlDefault
    Set oHttp = Nothing       
  End sub
ーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーー
Public Function GetText(prmAllText As String, prmStrText, prmEndText)
    Dim wStrNo      As Long
    Dim wEndNo      As Long
    wStrNo = InStr(1, prmAllText, prmStrText) + Len(prmStrText)
    wEndNo = InStr(wStrNo, prmAllText, prmEndText)
    GetText = Mid$(prmAllText, wStrNo, wEndNo - wStrNo)
End Function
－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－

ここでは、EXCEL表の6行目から証券コードの記入が始まっています。
Cells(wRow, 4)は、EXCEL表の４列目に、証券コードを記載している事を
示しています。

GetText Fanctionで、Yahooから受取った該当証券コード情報の内、
.responsetext内の<Title>～</title>行にある【】に挟まれた証券コードを
抜き取っています。
Yahooファイナンスの各銘柄データは、１銘柄毎の全体量が100Kbぐらい あり
ますので、非力なEXcelの関数で100Kbを１バイト単位に比較して株価データを
抜き取るには、銘柄数が1000件のもなれば処理時間が長くなってきます。
ここでは、受取ったHTMLデータの個別銘柄情報のすぐ前にある
<head>のタグから、信用取引情報の後ろの<footer>タグ
までの間を切り取って、比較用の cmpTextを作成しています。
抜き取り後のデータ量は、35Kb程度になりました。

 Yahooファイナンスからリアルタイム情報を取得する場合は、下記の1行を指定
 しないと、最新情報が得られません。この.setRequestHeaderの1行を指定しな
 いとサーバーに蓄積された古い情報をもってくる様です。
  Yahooは、AM8:00～AM9:00の間は、株価データのサービスを行っていない
 ため、各項目の欄に"---"が入っておりデータがありません。
 銘柄によっては、AM8:00～AM9:00の間の データが、サーバに残っている場合
 があります。この時間帯のデータを持ってきた場合には、データに抜けがでる
 事になります。

 .setRequestHeader "If-Modified-Since", "Thu, 01 Jun 1970 00:00:00 GMT"



2021.04.25
　Yahooファイナンスの仕様変更により情報収集ができなくなったので修正。
　日経平均株価；998407、TOPIX；998405は、Yahooのサービスが無くなりましたので表示できません。
2017.4.01
　Yahooファイナンスの仕様変更により情報収集ができなくなったので修正。接続先URLの変更。
2014.6.11
　Yafooファイナンスの仕様変更により、全情報が収集できなくなったため修正。
2014.5.21
　Yahooファイナンスの仕様変更により、「市場」情報が収集できなくなったので
　抜き取りタグの位置を変更。

]]> Yahoo VBA接続 2022-03-13T17:00:00+09:00 keizann NINJA BLOG keizann http://keizann.blog.shinobi.jp/-kabutomushi-/%E6%A0%AA%E5%AF%8C%E5%A4%A2%E5%A3%AB%E4%BF%A1%E7%94%A8%E5%8F%96%E5%BC%95%E3%80%80%E3%82%B5%E3%83%9D%E3%83%BC%E3%83%88 株富夢士信用取引　サポート よくある質問　Q &amp;amp; A 　【ver2.1】 　 Q1 &amp;nbsp;信用建余力や現引余力が証券会社の画面より低い値がでます。 　　なぜでしょうか？ A: &amp;nbsp;証券会社では、委託保証金率や持株信用保証評価などを、 　　リアルタイムで変化させています。このシートでは、 　　初期設定を行う... よくある質問　Q & A 　【ver2.1】
　
Q1  信用建余力や現引余力が証券会社の画面より低い値がでます。
　　なぜでしょうか？
A:  証券会社では、委託保証金率や持株信用保証評価などを、
　　リアルタイムで変化させています。このシートでは、
　　初期設定を行うだけで、細かい変化対応ができませんので、
　　証券会社の画面とは違いがでます。
　
Q2  新規注文の信建種別を選択して建単価、株数を記入したのに、
　　信用建資金の新規建玉欄に表示が何もでません。
A:  取引一覧表の証券コード欄の記入が漏れているからです。
　　記入した行が連続している場合は、一度注文実行ボタンを押せば
　　前の行の銘柄名、証券コード、市場をコピーしてくれます。
　
Q3  建注文時に誤って注文実行ボタンの「はい」を押してしまいました。
　　どこを修正すれば元にもどせますか？
A:  注文日付欄に本日の日付が入っているので、これを削除する。
　　信建種別が「買残」又は「売残」になっているので元に戻す。
　　手数料演算エリアの注文手数料欄に、演算された手数料が入って
　　いるのでこれを削除する。
　　信用取引履歴表の1行目にに注文結果が入っているので、
　　該当する行を削除する。
　
Q4  返済注文時に誤って返済実行ボタンの「はい」を押してしまいました。
　　どこを修正すれば元にもどせますか？
A:  注文日付欄に本日の日付が入っているので、これを削除する。
　　注文の信建種別が「-」になっている場合は元に戻す。
　　注文の株数が、減算されているので元の株数に戻す。
　　返済欄の信建種別が「-」になっているので元に戻す。
　　戻株数がクリアされているので元の値に戻す。
　　確定損益に誤って実行した注文の損益が加算されているので、
　　その分を減算する。
　　手数料演算エリアの注文時手数料がクリアされているので
　　元の値にに戻す。
　　信用取引履歴表の1行目にに返済注文結果が入っているので、
　　該当する行を削除する。
　
Q5  警告メッセージの一部だけ使用したい場合はどの様に
　　設定すればよいですか？
A:  警告メッセージの保証金率欄を削除して空白にしてください。
　　例えば、40%、30%、20%、だけを使用したい時は、
    35%、25%、の部分を空白にします。
　　警告メッセージの文章欄はそのままにしておいてかまいません。
　
Q6  逆日歩の発生は、組入れられていますか？
A:  本シートでは、逆日歩の発生した事もわかりません、
　　かつ情報収集する事もできませんので対応していません。
　　逆日歩があった場合は、手持ち資金に誤差が出てきますので、
　　投資現金欄を証券会社の画面に従って修正してください。
]]> 株富夢士 2016-05-27T08:47:31+09:00 keizann NINJA BLOG keizann http://keizann.blog.shinobi.jp/excel%20vba/%E9%87%8D%E8%A4%87%E3%81%99%E3%82%8B%E3%83%87%E3%83%BC%E3%82%BF%E3%81%AE%E5%89%8A%E9%99%A4 重複するデータ行の削除 EXCEL表にキーとなるコードを入力していくと、コードの重複に気づかない 場合があります。この処理はデータに重複がある場合は、重複行を見つけ削除 する処理です。 この処理では、重複行を見つけると無条件に削除してしまいますので、 株価情報検索処理の銘柄登録には向いていますが、データベースの様な 個々の... EXCEL表にキーとなるコードを入力していくと、コードの重複に気づかない
場合があります。この処理はデータに重複がある場合は、重複行を見つけ削除
する処理です。
この処理では、重複行を見つけると無条件に削除してしまいますので、
株価情報検索処理の銘柄登録には向いていますが、データベースの様な
個々のデータ行が重要な意味を持つ処理には向いていません。
ここでは１列1行目から比較を開始して、2行目以降100行目までに、
データの重複があった場合に、比較行より先にある行の削除を行います。
重複する行が点在して複数回出現しても、連続したデータとなっていても
かまいません。
行削除には、.EntireRow.Deleteコマンドを使用します。
途中に空白行があれば、その空白行以降の空白行は削除されます。

Private Sub sample()
Dim wRow       As Integer
Dim cRow       As Integer
Dim sRow       As Integer
Dim cKazu      As Integer

    wRow = 1
    sRow = 100
 For cKazu = 1 To sRow
     cRow = wRow + 1
   Do Until cRow > sRow
     If Cells(wRow, 1) = Cells(cRow, 1) Then
        Cells(cRow, 1).EntireRow.Delete
        cRow = cRow - 1
     End If
        cRow = cRow + 1
   Loop
    wRow = wRow + 1
 Next
End Sub




 

]]> EXCEL VBA 2014-04-15T10:33:40+09:00 keizann NINJA BLOG keizann