[PR]
[PR]上記の広告は3ヶ月以上新規記事投稿のないブログに表示されています。新しい記事を書く事で広告が消えます。
[PR]上記の広告は3ヶ月以上新規記事投稿のないブログに表示されています。新しい記事を書く事で広告が消えます。
Yahooファイナンスの時系列データページ
赤で囲んだ部分が収集情報の各項目
Yahooファイナンスから時系列情報を受け取って比較用のcmpTextを作成
した後、個々の数値情報を抜き取る処理です。
ここでは、各銘柄の時系列情報のページから4日分を抜き取っています。
Yahooファイナンスの時系列情報ページは、PM7:00以降になると、
本日分の情報が、最新情報として反映されます。
このため、本日+過去3日分=4日分を収集しています。
-------------------------------------
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 '日付を除いた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ファイナンスの仕様変更により、「市場」情報が収集できなくなったので修正。