忍者ブログ

EXCEL VBAで あくせく

Yahooファイナンスから株価詳細情報の各項目取得

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