[PR]
×
[PR]上記の広告は3ヶ月以上新規記事投稿のないブログに表示されています。新しい記事を書く事で広告が消えます。
[PR]上記の広告は3ヶ月以上新規記事投稿のないブログに表示されています。新しい記事を書く事で広告が消えます。
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ファイナンスの仕様変更により、「市場」情報が収集できなくなったので修正。
[3回]
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の変更。
[1回]
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回]
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ファイナンスは、リアルタイムで株価情報を更新しており、
この情報を外部に無料で配信するサービスを行っています。
自分のパソコンから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ファイナンスの仕様変更により、「市場」情報が収集できなくなったので
抜き取りタグの位置を変更。
[8回]