エクセルで株の今期決算と３ヵ月決算を取得

質問

標題の件で、
エクセルのマクロでXMLHTTPを用いて株探というサイトの決算表から
"今期【予想】"と"３ヵ月業績の推移【実績】"のテーブルから数値を一通り取得したいです。

【参考例】
"エクセルでXMLHTTPを用いて株の経常益を取得"
https://okwave.jp/qa/q9123746.html

上記質問の回答のプログラムをいじってクラスモジュール内に格納したテーブルのデータから数値を取り出すようにやってみたんですが、まだクラスモジュールの概念で分かっていない部分があり上手くいきませんでした。
（もしクラスモジュール内に取りこんだHTMLのTableの処理について詳しく書かれたサイトを知っておりましたら、教えてくださると助かります）

【シートに取得したい内容について】
エクセルシートC4セルを開始位置にして、A4,A5,...に記載したコードの銘柄について株探の"今期【予想】"のテーブルの1行目～5行目の数値を1行目,2行目,・・・5行目の順に1行にまとめてセルに格納(合計40列)し、隣の列に"３ヵ月業績の推移【実績】"のテーブルの1行目～8行目の数値を1行目,2行目,・・・8行目の順に1行にまとめてセルに格納(合計64列)したいです。
※シート例
添付画像参照

回答者にはお礼しか言うことが出来ませんが、よろしくお願いします。

回答No.1

real beatin（@realbeatin） · ベストアンサー

こんにちは。
リンク先では、高速化という明確な要求ありきで、
色々ある中で、やや難度高めのWinHTTPやクラスモジュールを扱っています。
条件が異なるようですので、他の設計に替えた方が良いのかも、ですが、
混乱のないようあちらの書き換えに留めました。

HTMLTable>Rows>Cells
などのようにobj構造を理解した上で、
VBEのデバッグ機能をフル活用したりとか、
obj名をキーワードとして複数組合わせて検索するなどして、
具体的な要求に添った実働コードをサンプルとして
試しながら覚える方が習熟が早いように私は思います。
今回のクラスモジュールについては、単に待ち時間を減らす目的で、
イベントを必要としているだけの限定的な使い方ですから、
課題としてはひとまずHTMLTableに絞った方がいいのかも、です。

ーーーー
●ＶＢＥにて参照設定
　Microsoft WinHTTP Services, version 5.1
　Microsoft HTML Object Library
<中略>
●出力結果は上記ActiveSheetのA4から104列、
　A4から連続データ最下行まで。
※出力先シートを選択してから実行。
' ' //

' ' 参照設定
' '　 WinHTTP ■　Microsoft WinHTTP Services, version 5.1
' '　 MSHTML　■　Microsoft HTML Object Library
' ' 〓〓〓　標準モジュール　〓〓〓
Option Explicit
Private Const TRACKS As Long = 24&　 '　■Collectionの基準サイズ？

Public mtxSrc ' 読込用二次元配列
Public mtxExc ' 出力用〃今期【予想】+３ヵ月業績の推移【実績】
Public tnThreads As Long ' Thread 総件数
Public cnSent As Long ' Request/Send済のThread数
Public cnThRest As Long ' 未処理残件数( <> tnThreads - cnSent )
Private colCls As VBA.Collection　'　Class1クラスコレクション

Sub StartWinHttpRequest()
Dim tnCol As Long　'　Collectionの実行時サイズ
Dim i As Long
　Application.Cursor = xlWait
'　Sheets("Sheet1").Select　'　■◆シート名を指定して選択する場合　イキ◆
　With ActiveSheet
　　If .FilterMode Then .ShowAllData
　　mtxSrc = .Range("A4:A" & .Range("A4").End(xlDown).Row).Value　'　■データ先頭は A4 ？
　End With
　tnThreads = UBound(mtxSrc)
　ReDim mtxExc(1 To tnThreads, 1 To 40 + 64)
　tnCol = TRACKS
　If tnThreads < TRACKS Then tnCol = tnThreads
　cnSent = 0&
　cnThRest = tnThreads
　Set colCls = New Collection
　For i = 1 To tnCol
　　colCls.Add New Class1, CStr(i)
　Next i
End Sub

Private Sub ResPrint()
Dim nColPos As Long
　If colCls Is Nothing Then Exit Sub
　Set colCls = Nothing
　Cells(4, 3).Resize(tnThreads, 104).Value = mtxExc '　■　出力位置・内容は適宜
　Erase mtxSrc, mtxExc
　Application.Cursor = xlDefault
End Sub

' ' 〓〓〓　Class1（クラス）モジュール　〓〓〓
Option Explicit
Private Const URL1 As String = "http://kabutan.jp/stock/finance?code="　'　■
Private Declare PtrSafe Sub Sleep Lib "KERNEL32.dll" (ByVal dwMilliseconds As Long)
Private WithEvents oWinReq As WinHttpRequest
Private oDoc As HTMLDocument
Private nThrdIdx As Long　'　「今このクラスでは何番目を処理しているのか」

Private Sub Class_Initialize()
　Set oWinReq = New WinHttpRequest
　Me.RequestAsync
　Set oDoc = New HTMLDocument
End Sub

Private Sub oWinReq_OnResponseFinished()
Dim oElm As IHTMLElement
Dim oTable As HTMLTable
Dim oTable1 As HTMLTable
Dim sHTML As String
Dim ary
Dim sBuf As String
Dim i As Long
Dim j As Long
Dim c As Long

　sHTML = oWinReq.responseText
　oDoc.body.innerHTML = sHTML
　sHTML = ""
　Sleep (10)

　Set oElm = oDoc.getElementById("finance_box")

　For Each oTable In oElm.getElementsByTagName("table")
　　If oTable.PreviousSibling.innerText Like "今期【予想】" Then Set oTable1 = oTable
　　If oTable.PreviousSibling.innerText Like "３ヵ月業績の推移【実績】" Then Exit For
　Next
　Set oElm = Nothing
On Error GoTo bar40_
　c = oTable1.Rows(0).Cells.Length - 1
On Error GoTo 0
　For i = 1 To oTable1.Rows.Length - 2
　　For j = 0 To c
　　　sBuf = sBuf & vbTab & Trim$(oTable1.Rows(i).Cells(j).innerText)
　　Next j
　Next i
　Set oTable1 = Nothing
ln1_:
On Error GoTo bar64_
　c = oTable.Rows(0).Cells.Length - 1
On Error GoTo 0
　For i = 1 To oTable.Rows.Length - 2
　　For j = 0 To c
　　　sBuf = sBuf & vbTab & Trim$(oTable.Rows(i).Cells(j).innerText)
　　Next j
　Next i
　Set oTable = Nothing
ln2_:
　ary = Split(sBuf, vbTab)
　For i = 1 To UBound(ary)
　　mtxExc(nThrdIdx, i) = ary(i)
　Next i

' ' ▼未処理スレ数　減算▼
　cnThRest = cnThRest - 1&

　If cnSent < tnThreads Then
　　Me.RequestAsync
　Else
　　oWinReq.abort: Set oWinReq = Nothing: Set oDoc = Nothing
　' ' ▼未処理スレ数 = 0&　ならば▼最終出力処理
　　If cnThRest = 0& Then
　　　Application.OnTime Now, "ResPrint"
　　End If
　End If
Exit Sub

bar40_:
　sBuf = Application.Rept(vbTab & "-", 40)
　Resume ln1_
bar64_:
　sBuf = sBuf & Application.Rept(vbTab & "-", 64)
　Resume ln2_
End Sub

Sub RequestAsync()
　cnSent = cnSent + 1&
　nThrdIdx = cnSent
　With oWinReq
' '　WinHttp非同期リクエスト
　　.Open method:="GET", URL:=URL1 & CStr(mtxSrc(nThrdIdx, 1)), Async:=True
　　.send
　End With
End Sub

' ' //

お礼

素晴らしいプログラムのご回答をありがとうございます。
非常に助かりました！
実は他にも自動取得できるようにしたい内容(株探の"本日、年初来高値を更新した銘柄"のHTMLTableなど)もありまして、難易度が高めでしたら他の設計についても考えてみます。
本当にありがとうございました。