忍者ブログ

EXCEL VBAで あくせく

Yahooファイナンスから時系列データの各項目取得

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

 

拍手[3回]

PR