[PR]
×
[PR]上記の広告は3ヶ月以上新規記事投稿のないブログに表示されています。新しい記事を書く事で広告が消えます。
[PR]上記の広告は3ヶ月以上新規記事投稿のないブログに表示されています。新しい記事を書く事で広告が消えます。
[0回]
[0回]
[11回]
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回]