＜2022年7月2日現在のWebサイトでスクレイピングしています。今後サイトの仕様に変更があった場合は、下記のコードではスクレイピングできない場合があります＞
「Excel VBA」で、IEやSeleniumBasicを使わずに、「HTTP通信」のみで、ヤフーファイナンスの時価総額ランキングをすべてExcelシートに書き出すコードです。
「HTTP通信」では、サイトの次ページを読み込む際に、ユーザのリアル操作が必要となりますので、意図的に空のユーザーフォーム（UserForm1）を開閉しています。
（書き出すExcelシートには、予めヘッダーや書式等を設定しておきます）
Sub ヤフーファイナンス情報取得_spot_HTTP()
Const SHOWCNT As Integer = 50
On Error Resume Next
Dim httpreq As Variant
Set httpreq = CreateObject("MSXML2.XMLHTTP")
httpreq.Open "GET", "https://finance.yahoo.co.jp/stocks/ranking/marketCapitalHigh?market=all&term=daily"
httpreq.send
Do While httpreq.readyState < 4
DoEvents
Loop
Dim html As Variant
Set html = CreateObject("htmlfile")
html.write httpreq.responseText
'以下で開いたユーザーフォームが1秒後に閉じる
Application.OnTime Now() + TimeSerial(0, 0, 1), "CloseUserForm"
UserForm1.Show
Dim strCntCss As String
strCntCss = "#root > main > div > div.rMa89KwT._34OEfNCy._2STjqM5M > div.XuqDlHPN > section > div > div._3G6OUGtH > div > div > p:nth-child(1)"
'トータル件数を取得
Dim strCnt As String
strCnt = html.querySelector(strCntCss).innerText
strCnt = Mid(strCnt, InStr(strCnt, "/") + 2, 4) * 1
'繰り返し回数を計算
Dim maxCnt As Integer
maxCnt = strCnt / SHOWCNT
With ThisWorkbook.Worksheets("HTTP") '情報を書き出すシート名を「HTTP」とする
Dim clrMaxRow As Integer
Dim clrMaxClmn As Integer
clrMaxRow = .Cells(.Rows.Count, 2).End(xlUp).Row
clrMaxClmn = .Cells(2, .Columns.Count).End(xlToLeft).Column
.Range(.Cells(2, 2), .Cells(clrMaxRow, clrMaxClmn)).ClearContents
Dim starttime As Date '処理の開始時刻を格納
starttime = Time
Dim i As Integer
Dim j As Integer
Dim x As Integer
j = 1
x = 1
For i = 1 To maxCnt
Dim trs As Object
Dim tr As Object
Dim tds As Object
Dim td As Object
Set trs = html.getElementsByTagName("tr")
For Each tr In trs
Dim k As Integer
Dim m As Integer
k = 1
m = 0
.Cells(j, k) = tr.getElementByTagname("th").innerText
k = k + 1
Dim strTexts As Variant
Dim strText As Variant
Set tds = tr.getElementsByTagName("td")
For Each td In tds
Select Case k
Case 2
Dim l As Integer
l = 0
strTexts = Split(td.innerText, vbLf)
For Each strText In strTexts
If l = 0 Then
.Cells(j, k + l + m) = Left(strText, Len(strText) - 5)
l = l + 1
.Cells(j, k + l + m) = Right(strText, 5) * 1
l = l + 1
Else
.Cells(j, k + l + m) = strText
l = l + 1
End If
Next strText
m = m + l - 1
Case 3
l = 0
strTexts = Split(td.innerText, vbLf)
For Each strText In strTexts
If l = 1 Then
.Cells(j, k + l + m) = strText * 1
Else
.Cells(j, k + l + m) = strText
End If
l = l + 1
Next strText
m = m + l - 1
Case 4
.Cells(j, k + m) = _
Left(td.innerText, InStr(td.innerText, "株") - 1) * 1
Case 5
.Cells(j, k + m) = _
Left(td.innerText, InStr(td.innerText, "百") - 1) * 1
Case Else
l = 0
strTexts = Split(td.innerText, vbLf)
For Each strText In strTexts
.Cells(j, k + l + m) = strText * 1
l = l + 1
Next strText
End Select
k = k + 1
Next td
Set tds = Nothing
j = j + 1
Next tr
Set trs = Nothing
Set html = Nothing
Set httpreq = Nothing
x = x + 1
Set httpreq = CreateObject("MSXML2.XMLHTTP")
httpreq.Open "GET", _
"https://finance.yahoo.co.jp/stocks/ranking/marketCapitalHigh?" & _
"market=all&term=daily&page=" & x
httpreq.send
Do While httpreq.readyState < 4
DoEvents
Loop
Set html = CreateObject("htmlfile")
html.write httpreq.responseText
'以下で開いたユーザーフォームが1秒後に閉じる _
（この操作を入れなければ次ページのhtmlを読み込まない）
Application.OnTime Now() + TimeSerial(0, 0, 1), "CloseUserForm"
UserForm1.Show
j = j - 1
Application.StatusBar = i & "/" & maxCnt & " _
(" & (Format(i / maxCnt, "0.0%")) & ")"
Next i
.Columns.AutoFit
End With
Dim EndTime As Date '処理の終了時刻を格納
EndTime = Time
EndTime = EndTime - starttime
MsgBox ("所要時間は" & Minute(EndTime) & "分" & Second(EndTime) & "秒でした")
End Sub
Sub CloseUserForm()
On Error Resume Next 'ユーザーが閉じてしまった場合の想定
Unload UserForm1
On Error GoTo 0
End Sub「SeleniumBasic」でも同様のことができますが、「SeleniumBasic」では実際にブラウザを操作しますので、非常に時間がかかります。
（2022年7月2日時点での上記時価総額ランキングのトータル件数は約4,000件ですが、これをすべて書き出すのに、「SeleniumBasic」では約15分かかるところ、「HTTP通信」では約2分で済みます）
コメント