VBA練習　Excellデータスクレイピングツール　食べログ版　初心者向けプログラミング

VBAスクレーパー　第二弾（食べログ版）を作ってみました
1. まずは、こちらからダウンロードしてください
2. VBAスクレーパー（食べログ版）
いくつかの注意点があります。

VBAスクレーパー　第二弾（食べログ版）を作ってみました

まずは、こちらからダウンロードしてください

VBAスクレーパー（食べログ版）

1 ファイル 180.80 KB

ダウンロード

ダウンロードしたファイルは解凍してお使いください。

本ソフトは30日間の使用期限付きです。それ以降も使いたいときは下記リンクからベクター登録のソフトをお買い上げください。お買い上げいただくとライセンスキーが発行されますので使用期限は解除されます。また、シートやVBAエディターのロックも解除できますからプログラムを参照することもできるようになります。

作者: AYUTOKUNN

現在登録申請中です。まだリンクできませんから少しお待ちください。

いくつかの注意点があります。

インターネットエクスプローラを使う仕様になっている

ご存じのようにIEエクスプローラはサポートが終了していますから、いずれは使えなくなるのかもしれません、最新のEdgeでできるようにしたいと思っていますが、少し時間がかかりそうです。

同じサイトを同じキーワードで検索した結果、IEエクスプローラとEdgeでは表示する件数や並び順がかなり違うようですからあらかじめご承知ください。

データを取り出すのに少し時間がかかる

ブラウザを起動しパージを表示するときや、ページを切り替えるときなどにデータを読み込むのに多少時間を要します。
読み込み時何らかの障害によってデータの取り出しに失敗することがあります。取り出すデータの行数を３５０件に制限しています（ちなみに千代田区のラーメンで検索をかけるとIEエクスプローラでは324件表示します<Edgeでは350件程度>）このくらいのデータは取り出すのに5分ほどかかります。エクセル2013なら仕組み上100万件以上が読み込めますが、まあ、300件程度が限界かなと思います。

データ抽出ボタンを押してから最初にブラウザが表示されたとき注意ウインドウが開くときがあります。これは、手動で閉じてください。

又、データ読み込みの経過を示すプログレスバーを表示しますが、これが表示されるまでにも少し時間がかかります（10秒ていどかな）

セルに独自のデータを書き込む場合注意

データの読み込み開始ボタンをクリックすると、前回までに読み込まれたデータを削除します。

データの削除には以下のコードを使っています

‘データ領域削除
ActiveSheet.Cells(9, 1).CurrentRegion.Offset(1).ClearContents

Cells(9, 1)から始まる連続したセルのカレントレジオン（データベース領域）を消す設定です。ユーザーが独自にセルに何かデータを書き込むことがあると思いますが、注意が必要です。

つまり8行目の空白行にデータを書き込んでしまうと、カレントレジオンはCell(８，１)と解釈してしまうので、Offset(１)ですから9行目の項目データを消してしまいます。

結果、ページデータを取り出してシートに転記するとき項目データが書き込まれたセル位置を基準にしているのでとんでもない結果に見舞われます。

もちろん、そのようなことを考慮してプログラムしなければなりませんが、今のところ勉強のためとりあえずの仕様になっていますからご承知ください。

データ取り出しの肝　DevToolsの参照

ブラウザ（ここではEdge）を開いてサイト表示（ここでは食べログ）して「千代田区」「ラーメン」で検索をします。

検索結果ページが表示誰た状態で「F12」キーをクリックすると下記のようにDevToolsを開くか聞いてきますので開くボタンを押します。

ページを構成しているHTMLファイルが表示されます。これを利用します。

上図赤丸で囲んだアイコンをクリックしたうえで、下図の様にページ中の評価の項目にマウスカーソルを合わせて、クリックします。

クリックした評価を構成している部分が右側のHTMLファイルに強調表示されます。

3.75というtextは　<span　Class=”c-rating__val・・・・・”　というクラス名に属するTextであることがわかりますね。

そしてそのクラス名をダブルクリックしてコピーしておきます。ここで「Ctrl＋F」キーを押します。

下図の下のほうに赤で囲ったところに検索窓が開きますから、そこにクラス名を貼り付けます。

青まるで囲ったように 1/19 となっています。これはこのページに19個の評価のTextがあるということです。

食べログでは1ページに20店舗の情報が配置されているので、このページには評価の項目がない店があることを意味します。

下図ではそれを確認します。

評価のText 3.75があるクラスが属する親のクラスを探します。

ここでは”list-rst__rate”というクラスを見てみます。

上でやったのと同じように検索窓にクラス名を入れると、1/20となっています。

このクラスはそのお店情報が店名を含むすべての情報を全体的に表現しているクラスですから絶対に20個あるはずだと思い込みます。評価の項目がない、喫煙情報や定休日情報がないことはあるかもしれませんから、そのことを知ることが重要です。

以上のようにデータを取り出すために得たクラス名は以下のようにコードで表現します

'その他の項目表記(評価)
Sub otherinfo(ByRef obIE As Object)
    Dim r_max As Long
    Dim str As String
    Dim objotherInfo As Object
    Dim objotherInfo2 As Object
    'Dim el As IHTMLElement
    '----------------------------------------------
    Dim i As Integer
    Dim countcolec As Integer
    countcolec = obIE.Document.getElementsByClassName("list-rst__rate").Length  '20個

    i = 0
    
    For Each objotherInfo In obIE.Document.getElementsByClassName("list-rst__rate") '20個
        '"list-rst__rate"は20個あるが評価以外のTextも含まれるから評価部分の数値だけ持っているクラスを指定して拾う
        If InStr(objotherInfo.outerHTML, """c-rating__val c-rating__val--strong list-rst__rating-val""") > 0 Then   '17個
            '17個のクラスを拾う
            For Each objotherInfo2 In objotherInfo.getElementsByClassName("c-rating__val c-rating__val--strong list-rst__rating-val")
                str = objotherInfo2.innerText
            
                r_max = row_Max(4)  'D列指定
            
                ActiveSheet.Cells(r_max, 4).Value = str
                With ActiveSheet.Cells(r_max, 4)
                    .VerticalAlignment = xlBottom
                    .NumberFormatLocal = "G/標準"
                    .WrapText = False
                    .Orientation = 0
                    .AddIndent = False
                    .ShrinkToFit = True
                    .ReadingOrder = xlContext
                    .MergeCells = False
                End With
            Next objotherInfo2
        Else
            r_max = row_Max(4)  'D列指定
            '評価の項目がないときは”ー１”とする（他の文字列だと並べ替えに差しさわりがでる）
            ActiveSheet.Cells(r_max, 4).Value = "-1"
        End If
               i = i + 1
                'プログレスバーの進捗を更新表示
                UserForm1.sinkou_val countcolec, i
    Next objotherInfo
    
End Sub

'その他の項目表記(評価)

Sub otherinfo(ByRef obIE As Object)

Dim r_max As Long

Dim str As String

Dim objotherInfo As Object

Dim objotherInfo2 As Object

'Dim el As IHTMLElement

'----------------------------------------------

Dim i As Integer

Dim countcolec As Integer

countcolec = obIE.Document.getElementsByClassName("list-rst__rate").Length '20個

i = 0

For Each objotherInfo In obIE.Document.getElementsByClassName("list-rst__rate") '20個

'"list-rst__rate"は20個あるが評価以外のTextも含まれるから評価部分の数値だけ持っているクラスを指定して拾う

If InStr(objotherInfo.outerHTML, """c-rating__val c-rating__val--strong list-rst__rating-val""") > 0 Then '17個

'17個のクラスを拾う

For Each objotherInfo2 In objotherInfo.getElementsByClassName("c-rating__val c-rating__val--strong list-rst__rating-val")

str = objotherInfo2.innerText

r_max = row_Max(4) 'D列指定

ActiveSheet.Cells(r_max, 4).Value = str

With ActiveSheet.Cells(r_max, 4)

.VerticalAlignment = xlBottom

.NumberFormatLocal = "G/標準"

.WrapText = False

.Orientation = 0

.AddIndent = False

.ShrinkToFit = True

.ReadingOrder = xlContext

.MergeCells = False

End With

Next objotherInfo2

Else

r_max = row_Max(4) 'D列指定

'評価の項目がないときは”ー１”とする（他の文字列だと並べ替えに差しさわりがでる）

ActiveSheet.Cells(r_max, 4).Value = "-1"

End If

i = i + 1

'プログレスバーの進捗を更新表示

UserForm1.sinkou_val countcolec, i

Next objotherInfo

End Sub

objotherInfoにClassName(“list-rst__rate“)コレクションを一個づつ取り出します

（　list-rst__rateのアンダーバーの部分は全角に見えますが、ではなく、半角のアンダーバーが2個並んでいる状態ですから注意してください　）

For Each objotherInfo In obIE.Document.getElementsByClassName(“list-rst__rate“) ’20個

objotherInfoは親のクラスですから、その中に子のクラスがあるか調べます

“c-rating__val c-rating__val–strong list-rst__rating-val”が子のクラス名です

outerHTMLはクラス名、タブ名、id名などを含む全てのHTML情報が書いてありますからInStr関数を使ってその中に探すクラス名文字列があるか調べています。InStr関数は検索文字列が存在する位置を返します。つまり存在すれば０以上の数値が返りますから＞０がtrueなら存在するです。

If InStr(objotherInfo.outerHTML, “””c-rating__val c-rating__val–strong list-rst__rating-val“””) > 0 Then ’17個

(文字列を検索するとき　例えば　テストを検索するときは
InStr(objotherInfo.outerHTML,”テスト”）ですが

“”を含めた“テスト”を検索するときは
InStr(objotherInfo.outerHTML,”””テスト”””）になります

つまり、文字列をくくるダブルクォーテーションの中に　“　を含めるときは二個重ねるということです。

例　①を親のクラスとして②③は子のクラスになっているレビュー項目のクラスがあります
①　”list-rst__rvw-count”
②　”list-rst__rvw-count-target”
③　”list-rst__rvw-count-subject gly-b-review”
それぞれ別々のクラス名を持っていますが、前半部分は同じ文字列になっています。
このことから、ある検索をするとき

InStr(objotherInfo.outerHTML, “list-rst__rvw-count”) > 0 とすると80個のクラスを探し出してしまいます。ところが、
InStr(objotherInfo.outerHTML, “””list-rst__rvw-count”””) > 0 とする20個となり正しく検出できます。つまりページを構成するHTMLファイルの中身を注意深く観察し正しく検出できるようにしなければなりません。

子のクラスが存在することが分かったら、親のクラスの中から子のクラスコレクションをobjotherInfo2に取り出します

これが親のコレクションです↓
For Each objotherInfo2 In objotherInfo.getElementsByClassName(“c-rating__val c-rating__val–strong list-rst__rating-val“)

取り出したクラスのText 情報だけを取り出します。これで評価の数値を取り出せました。

innerTextは文字情報だけをもっています。

str = objotherInfo2.innerText

以上のように、その他の項目についても同様の方法で情報を取り出します。