ブログ｜EXCEL VBAであくせく

[PR]

2025年01月18日

×

[PR]上記の広告は3ヶ月以上新規記事投稿のないブログに表示されています。新しい記事を書く事で広告が消えます。

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)が
　収集できなくなったので修正。

[6回]

PR

Yahooファイナンスから時系列情報の取得

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の変更。

[5回]

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ファイナンスの仕様変更により、「市場」情報が収集できなくなったので
　抜き取りタグの位置を変更。

[11回]

株富夢士信用取引　サポート

よくある質問　Q & A 　【ver2.1】

Q1 信用建余力や現引余力が証券会社の画面より低い値がでます。

　　なぜでしょうか？

A: 証券会社では、委託保証金率や持株信用保証評価などを、

　　リアルタイムで変化させています。このシートでは、

　　初期設定を行うだけで、細かい変化対応ができませんので、

　　証券会社の画面とは違いがでます。

Q2 新規注文の信建種別を選択して建単価、株数を記入したのに、

　　信用建資金の新規建玉欄に表示が何もでません。

A: 取引一覧表の証券コード欄の記入が漏れているからです。

　　記入した行が連続している場合は、一度注文実行ボタンを押せば

　　前の行の銘柄名、証券コード、市場をコピーしてくれます。

Q3 建注文時に誤って注文実行ボタンの「はい」を押してしまいました。

　　どこを修正すれば元にもどせますか？

A: 注文日付欄に本日の日付が入っているので、これを削除する。

　　信建種別が「買残」又は「売残」になっているので元に戻す。

　　手数料演算エリアの注文手数料欄に、演算された手数料が入って

　　いるのでこれを削除する。

　　信用取引履歴表の1行目にに注文結果が入っているので、

　　該当する行を削除する。

Q4 返済注文時に誤って返済実行ボタンの「はい」を押してしまいました。

　　どこを修正すれば元にもどせますか？

A: 注文日付欄に本日の日付が入っているので、これを削除する。

　　注文の信建種別が「-」になっている場合は元に戻す。

　　注文の株数が、減算されているので元の株数に戻す。

　　返済欄の信建種別が「-」になっているので元に戻す。

　　戻株数がクリアされているので元の値に戻す。

　　確定損益に誤って実行した注文の損益が加算されているので、

　　その分を減算する。

　　手数料演算エリアの注文時手数料がクリアされているので

　　元の値にに戻す。

　　信用取引履歴表の1行目にに返済注文結果が入っているので、

　　該当する行を削除する。

Q5 警告メッセージの一部だけ使用したい場合はどの様に

　　設定すればよいですか？

A: 警告メッセージの保証金率欄を削除して空白にしてください。

　　例えば、40%、30%、20%、だけを使用したい時は、

35%、25%、の部分を空白にします。

　　警告メッセージの文章欄はそのままにしておいてかまいません。

Q6 逆日歩の発生は、組入れられていますか？

A: 本シートでは、逆日歩の発生した事もわかりません、

　　かつ情報収集する事もできませんので対応していません。

　　逆日歩があった場合は、手持ち資金に誤差が出てきますので、

　　投資現金欄を証券会社の画面に従って修正してください。

[0回]

重複するデータ行の削除

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

[0回]

	株富夢士信用取引
	株富夢士(かぶとむし)
	Keizannの食べログ
	渓山の油絵もろもろ
	香潮渓山美術館
	けいざんのDIY工房
	管理画面
	新しい記事を書く