忍者ブログ

EXCEL VBAで あくせく

[PR]

×

[PR]上記の広告は3ヶ月以上新規記事投稿のないブログに表示されています。新しい記事を書く事で広告が消えます。


接続時間測定

Yahooファイナンスからデータを取得する時の応答時間を計測してみました。
時間計測には、Timer関数を使用します。
Timer関数は、午前0時から経過した秒数を表す単精度浮動小数点数型の
値を返しますので、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://stocks.finance.yahoo.co.jp/stocks/detail/?code=" & 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, "contents-body", "contents-footer")
  End With
'------------------------------------ 
   EdTim = Timer
  Msgbox "処理時間は、" & EdTim - StTim & "秒です。"
End Sub

自宅の回線はBフレッツ光で、屋内は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回入っています。
この結果からみると、1件あたりの平均情報収集時間は、0.5秒程度と
みた方が無難でしょう。
実際に1000件のデータを収集してみると、約9分かかっています。
ではインターネットの混雑状況は、時間帯により違うため計測時間が
変わるのではないかと予測して時間帯を変えて測定してみました。

時間帯別測定結果
1.    7:00~ :8分50秒
2.     14:30~ :9分27秒
3.  19:30~ :8分45秒   
4.  21:00~ :8分40秒

結果からみると、インターネットの混雑状況による測定時間の
変化はほとんどないとみてよいでしょう。


2017.04.01 Yahooの仕様変更により情報収集ができなくなったので修正。
      接続先URLの変更。



拍手[1回]

PR

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, "<h1>", "</h1>")
          Cells(wRow,3) = strText
  '【市場】 取得
     strText = GetText(cmpText, "stockMainTabName"">", "</span>")
      If wCellB(4) = 998407 Or wCellB(4) = 998405 Then
                strText = "-"
         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
-------------------------------------
日経平均・TOPIXと個別銘柄は、ページのデザインが違うので分けています。
998407:日経平均
998405:TOPIX




2014.5.21 Yahooファイナンスの仕様変更により、「市場」情報が収集できなく
なったので修正。

 

拍手[2回]


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

Yahooファイナンスのトヨタ自動車のページ
赤で囲んだ部分が収集する情報詳細の各項目部分。


Yahooファイナンスに接続して、各銘柄毎の株価情報を受け取って、比較用の
cmpTextを作成後に、個々の数値情報を抜き取る処理です。
Yahooファイナンスのページからリアルタイムに更新されている株価詳細情報と
参考指標(1株配当・PER・PBR・EPS・BPS)を収集します。
この部分はYahooファイナンスのページデザインの変更が行われた場合には
その日から収集ができなくなってしまいます。

  If syCode = Cells(wRow,4) Then
    Cells(wRow, 4).Select
    '【銘柄名】取得
     strText = GetText(cmpText, "<h1>", "</h1>")
          Cells(wRow,3) = strText
    '【市場】取得
     strText = GetText(cmpText, "stockMainTabName"">", "</span>")
       If wCellB(4) = 998407 Or wCellB(4) = 998405 Then
               strText = "-"
       End If
          Cells(wRow,5) = strText
     strText = GetValue(cmpText, ">単元株数<")
        If Left(strText, 3) = "---" Then
           strText = 1
        End If
          Cells(wRow,7) = strText
     strText = GetValue(cmpText, ">始値<")
        If IsNumeric(strText) = False Then
          strText = 0
        End If
          Cells(wRow,8) = strText
     strText = GetValue(cmpText, ">高値<")
        If IsNumeric(strText) = False Then
           strText = 0
        End If
          Cells(wRow,9) = strText
     strText = GetValue(cmpText, ">安値<")
        If IsNumeric(strText) = False Then
           strText = 0
        End If
          Cells(wRow,10) = strText
     strText = GetText(cmpText, "stoksPrice"">", "</td>")
        If IsNumeric(strText) = False Then
           strText = 0
        End If
          Cells(wRow,11) = strText
     strText = GetText(cmpText, ">前日比</span>", "</td>")
     strText = GetText(strText, "yjMSt"">", "(")
          If IsNumeric(strText) = False Then
             strText = 0
          End If
          Cells(wRow,12) = strText
     strText = GetValue(cmpText, ">出来高<")
        If IsNumeric(strText) = False Then
           strText = 0
        End If
          Cells(wRow,13) = strText
     strText = GetValue(cmpText, ">年初来安値<")
        If IsNumeric(strText) = False Then
           strText = GetText(cmpText, "yjSt"">更新<", ">年初来安値<")
           strText = GetText(strText, "Fin"">", "</strong>")
        End If
        If IsNumeric(strText) = False Then
           strText = "-"
        End If
         Cells(wRow,14) = strText
     strText = GetValue(cmpText, ">年初来高値<")
        If IsNumeric(strText) = False Then
           strText = GetText(cmpText, "yjSt"">更新<", ">年初来高値<")
           strText = GetText(strText, "Fin"">", "</strong>")
        End If
        If IsNumeric(strText) = False Then
           strText = "-"
        End If
            Cells(wRow,15) = strText
     strText = GetValue(cmpText, ">EPS<")
     strText = GetText(strText, ">", "</a>")
     strText = Replace(strText, "(連)", "", 1)
     strText = Replace(strText, "(単)", "", 1)
        If IsNumeric(strText) = False Then
           strText = "-"
        End If
          Cells(wRow,18) = strText
     strText = GetValue(cmpText, ">PER<")
     strText = Replace(strText, "(連)", "", 1)
     strText = Replace(strText, "(単)", "", 1)
        If IsNumeric(strText) = False Then
        If Cells(wRow,18) = "-" or Cells(wRow,18) < 0 Then
           strText = "-"  
          Else
          strText = Cells(wRow,11) / Cells(wRow,18)
          End If
        End If
          Cells(wRow,16) = strText
     strText = GetValue(cmpText, ">BPS<")
     strText = GetText(strText, ">", "</a>")
     strText = Replace(strText, "(連)", "", 1)
     strText = Replace(strText, "(単)", "", 1)
        If IsNumeric(strText) = False Then
           strText = "-"
        End If
          Cells(wRow,19) = strText
     strText = GetValue(cmpText, ">PBR<")
     strText = Replace(strText, "(連)", "", 1)
     strText = Replace(strText, "(単)", "", 1)
        If IsNumeric(strText) = False Then
        If Cells(wRow,19) = "-" or Cells(wRow,19) < 0 Then
            strText = "-"
         Else
            strText = Cells(wRow,11) / Cells(wRow,19)
         End If
       End If
         Cells(wRow,17) = strText
     strText = GetValue(cmpText, ">1株配当<")
        If IsNumeric(strText) = False Then
           strText = 0
        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
-------------------------------------

 市場選択は4桁部分に同一証券コードがあるため、市場選択のページがある事を
考慮して います。年初来安値と年初来高値は、安値・高値を更新をした場合に、
数値の前に"更新"の文字が入る事を考慮しています。
1株利益(EPS)を開示しているのに、株価収益率(PER)を開示していない銘柄が
ありますが、これは1株利益(EPS)が開示されており、かつ値が正の場合は
株価から演算できますので、 PER = 株価 ÷ EPS で演算しています。
1株株主資産(BPS)を開示しているのに、純資産倍率(PBR)を開示していない
銘柄がありますが、これは1株株主資産(BPS)が開示されており、かつ値が正の
場合は株価から演算できますので、 PBR = 株価 ÷ BPS で演算しています。



 2014.5.21 Yahooファイナンスの仕様変更により、「市場」情報が収集できなく
 なったので修正。 
2014.4.25 Yahooファイナンスの仕様変更により、1株利益(EPS)、1株株主
     資産(BPS)が収集できなくなったので修正。

拍手[3回]


Yahooファイナンスから時系列情報の取得

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) Or Cells(wRow, 4) = 998407 Or Cells(wRow, 4) = 998405 Then
  With oHttp
     strURI = "https://stocks.finance.yahoo.co.jp/stocks/history/?code=" & 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, "contents-body", "contents-footer")
  End With
   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

     ---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が、stocks/history/?code=
になっている事に気づいてください。
ここでは、EXCEL表の6行目から証券コードの記入が始まっています。
Cells(wRow, 4)は、EXCEL表の4列目に、証券コードを記載している事を示しています。
998407 ;日経平均株価
998405 ;TOPIX
GetText Fanctionで、Yahooから受取った該当証券コード情報の内、
.responsetext内の<Title>~</title>行にある【】に挟まれた証券コードを
抜き取っています。
Yahooファイナンスの各銘柄データは、1銘柄毎の全体量が100Kbぐらい
ありますので、非力なEXcelの関数で100Kbを1バイト単位に比較して株価
データを抜き取るには、銘柄数が1000件のもなれば処理時間が長くなって
きます。 ここでは、受取ったHTMLデータの個別銘柄情報のすぐ前にある
<contents-body>のタグから、信用取引情報の後ろの<contents-footer>タグ
までの間を切り取って、比較用の cmpTextを作成しています。
抜き取り後のデータ量は、3Kb程度になりました。
Yahooファイナンスからリアルタイム情報を取得する場合は、下記の1行を指定
しないと、最新情報が得られません。この.setRequestHeaderの1行を指定しない
とサーバーに蓄積された古い情報をもってくる様です。
 
しかし、時系列データの場合は、そもそもが蓄積データのため、この1行は
コメントアウトしました。これをコメントアウトすると約15%程度収集速度が、
 向上します。これは、負荷のかかっているリアルタイムサーバに最新データを
要求して応答が返ってくるまでの処理時間が無くなったからだと 思います。

コメントアウトした1行
 .setRequestHeader "If-Modified-Since", "Thu, 01 Jun 1970 00:00:00 GMT"


2017.04.01 Yahooの仕様変更により情報収集ができなくなったので修正。
      接続先URLの変更。


 

拍手[3回]


Yahooファイナンスから株価詳細情報を取得

 Yahooファイナンスは、リアルタイムで株価情報を更新しており、
この情報を外部に無料で配信するサービスを行っています。
自分のパソコンからEXCELシートを開いて、EXCEL VBAを起動して
Yahooに接続すれば、リアルタイムの株価情報を取得する事ができます。
Yahooファイナンスのページは、リアルタイム情報を表示する「詳細情報」の
ページと、前日までの情報を表示する「時系列」情報ページがあります。
「詳細情報」のページは、東証の株価情報を1分以内の遅れで表示しており
このデータを元にして、PERやPBRなどのデータも変化しています。
VBAでYahooファイナンスから情報を取得するための記述は、
下記の様になります
EXCELシートに追加したコマンドボタン1に、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) Or Cells(wRow, 4) = 998407 Or  Cells(wRow, 4) = 998405 Then
  With oHttp
    strURI = "https://stocks.finance.yahoo.co.jp/stocks/detail/?code=" & 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, "contents-body", "contents-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表の4列目に、証券コードを記載している事を
示しています。
998407 ;日経平均株価
998405 ;TOPIX
GetText Fanctionで、Yahooから受取った該当証券コード情報の内、
.responsetext内の<Title>~</title>行にある【】に挟まれた証券コードを
抜き取っています。
Yahooファイナンスの各銘柄データは、1銘柄毎の全体量が100Kbぐらい あり
ますので、非力なEXcelの関数で100Kbを1バイト単位に比較して株価データを
抜き取るには、銘柄数が1000件のもなれば処理時間が長くなってきます。
ここでは、受取ったHTMLデータの個別銘柄情報のすぐ前にある
<contents-body>のタグから、信用取引情報の後ろの<contents-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"



2017.4.01 Yahooファイナンスの仕様変更により情報収集ができなくなったので修正。接続先URLの変更。
2014.6.11 Yafooファイナンスの仕様変更により、全情報が収集できなくなったため修正。

2014.5.21 Yahooファイナンスの仕様変更により、「市場」情報が収集できなくなったので抜き取りタグの位置を変更。

拍手[6回]


        
  • 1
  • 2