VBAスクレイパーVer１（スクレイピングツール）
ヤフオクサイトのにアクセスしてご希望のワードで検索後、商品リストを一覧にしてエクセルのワークシートに張り付けするVBAツールです。（10日間のお試し版です）
ベクター（フトウェア流通サイト）さんにて販売予定ですが、ベクターさんの事情で（コロナ禍で業務縮小中とのこと）登録に時間がかかっていて未だに登録できずにいますが、こちらからダウンロードできるようにしておきました。
ダウンロードファイルは圧縮しています。解凍してお使いください。（このファイルはエクセル2013で作成しています。お使いのPCにエクセルが必要です）
ファイルには10日間の試用期間が設定され無料でお試しいただけます。
その後も使いたい場合はベクター様から購入できます。
現在登録申請中ですが、作者ページで本ツールがまだ表示されていない場合は、登録完了までしばらくお待ちください。
主要コード解説
IE（インターネットエクスプローラー）を起動
１～３行目 objecIEを宣言して、”InternetExplorer.Application”を登録する。
６～11行目 ブラウザの大きさと開く位置を調整。
14行目 ブラウザを表示。
17～20行目 ブラウザにヤフオクのurlを渡してサイトを開く。
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 |
Dim objecIE As InternetExplorer 'IE起動 Set objecIE = CreateObject("InternetExplorer.Application") 'ブラウザの位置大きさ指定 With objecIE .Top = 50 'Y位置（上下） .Left = 50 'X位置（左右） .Width = 1000 'IEウィンドウの幅 .Height = 1000 'IEウィンドウの高さ End With 'ブラウザを表示（空の状態） objecIE.Visible = True 'urlを指定（ヤフオクに限定） url = Cells(3, 2).Value 'ブラウザにurlを渡してヤフオクを開く acse objecIE, url '（待機して3秒待ち） |
ヤフオクサイトを開く
上図の20行目のサブプロシージャ内容でヤフオクサイトにアクセスする。
|
1 2 3 4 5 6 7 8 9 10 11 12 |
'ヤフオクにアクセスして開く Sub acse(ByRef objecIE As Object, ByVal url As String) 'ヤフオク開く objecIE.Navigate url 'IE待機 IEtaiki objecIE '3秒間止まる（ここで待ちを入れないとエラーになる） sannbyoumati 3 End Sub |
|
1 2 3 4 5 6 7 8 9 10 |
'3秒停止関数 Function sannbyoumati(ByVal sec As Integer) Dim fTime As Date fTime = DateAdd("s", sec, Now) While Now < fTime DoEvents Wend End Function |
出品データを収集する
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 |
'*************************************************************** '■■■■ページを解析してデータを読み込むメインの処理開始■■ '*************************************************************** 'ページ当たりの表示する件数表示を調べる（規定は５０件になっている） Dim hyj_kensuu As Integer hyj_kensuu = kennsuu(objecIE) '総件数と比較してページを切り替えする繰り返す回数を計算 Dim forMax As Variant forMax = Application.RoundUp(sousuu / hyj_kensuu, 0) '少数切り上げ For i = 1 To forMax If i = 1 Then titlset objecIE '１回目の処理 ElseIf i >= 2 Then If tsugiPaige(objecIE) = True Then titlset objecIE 'ページを変えて2回目以降の処理 Else Exit For End If End If Next |
データをシートに転記する
15、16行目がブラウザから必要なデータを取り出すための重要なコードになります。
ブラウザを表示している状態で、「F12キー」を押すと、表示しているサイトの内容を構成している開発者用のツールが表示されます。
こんな感じで、上半分はサイトの情報で、下半分がその情報を構成しているHTMLファイルを含んだ開発者ツールです。
使い方はやや難解ですが、しばらくの間色々いじくって見てやっとその動作がわかったようです。欲しい情報の部分のHTMLタグとやらを自動的に表示してくれるようです。そのタグを手掛かりに取り出す情報の部分を切り取る作業を下のコードでしています。
下図の例ではエクスプローラでヤフオクサイトを開いて、検索窓に「エクセル」と書き込んで検索したとき最初に表示された画面の状態です。この状態で「F12キー」を押すと下半分に開発者用のツールが表示された状態です。
上半分の出品情報で「すべて」のタブを見ると8980件となっています。これは文字通りエクセル関連の出品情報が8980件あるという意味です。この状況で出品タイトル、価格情報などを一覧表で見たいというシチュエーションがあるとします。この様なネット情報からデータを一覧に取り出すにはデータスクレイピングという技術を利用します。エクセルのVBAにはこの様なネット情報を取り出すためのツールが組み込まれていますから、これを利用します。
上半分のこの様なウェブ情報はHTMLという言語でできているのだそうです。HTMLにはタグと呼ばれる目次みたいなものがついていてそのタグを目的にしてデータを取り出すことができるんです。
そのタグ情報を見つけるために利用するのが、F12キーで表示される開発者ツールなのです。
開発者ツールの使い方
出品タイトルを取り出すには、①に赤丸で囲った部分のアイコンを一回クリックします。
そして青矢印で示したようにマウスカーソルをタイトル部分に移動させクリックするとさらに矢印で示すように、②の様な薄い青色で反転表示した部分が表示され注意してみると、タイトル情報が書かれているHTMLが現れます。この中から具体的にタイトルを取り出すには
データスクレイピングの肝 objecIE.Document.getElementsByTagName
objecIE.Document.getElementsByTagName(“h3”) を使います。
一番最後のh3とは ②のところにあるタグの名前です。このh3タグはその上のliというタグの中に含まれていることがわかります。（ですから、liタグやその下のdivタグ使っても、OKなんです。更にclassの部分を使ってもできるんです）ここではh3に絞って解説します。
どうやらこのh3タグにタイトルやその他の情報が書き込まれていることがわかります。そして、更にaタグがあってこの中に赤文字でtitle＝”即決 Microsoft office2019最新版アプリ……”という部分を見つけることが出ます。
これでh3タグのtitle＝をコードで見つければタイトルを取り出すことができるんです。
このh3タグは各出品データごとに存在しますから、For Eachを使ってこのh3タグ情報を順番に取り出してやるんです。
For Each objectag In objecIE.Document.getElementsByTagName(“h3”)
そしてこのh3タグの中から更に、title＝を見つけるのが次のコードになります。
If InStr(objectag.outerHTML, “title=”””) > 0 Then
objectag.outerHTMLこの部分がaタグの内容すべてを表していますから、この中にtitle=が含まれている場合は0以上が帰ってくるのでタイトルが存在することがわかりますね。（ここでは存在することがわかればいいからその位置を知る必要がないので、＞０とします）
そして、具体的にタイトルを取りだすには
str = objectag.innerTextとするとタイトルだけを取り出すことができます。
そして、シートのどの位置にstrを書き込むか調べて（新規入力可能なセルの行位置）書き込みます。
objectag.innerTextでデータ取得
上図でのタイトルを取り出すときの要領で今度は価格情報を取り出してみます。
obIE.Document.getElementsByClassName(“Product__priceInfo”）
上図の例ではgetElementsByTagNameでしたが、今度はgetElementsByClassNameを使います。
前回同様 For Each を使って
For Each objprice In obIE.Document.getElementsByClassName(“Product__priceInfo”)とします。
開発ツールを使ってdiv、spanのタグのところの▼印をクリックして開けて中を見てみると価格情報が書かれているのが確認できます。つまり、このクラスネームを指定して探せば価格情報を取り出すことができるんです。具体的な取り出し方はobjectag.outerHTML と objectag.innerTextを使いますがouterHTML、innerTextをウェブで調べてみましょう。そして取り出し方を自分なりに工夫することが必要です、サイトの情報は常に変化します。そのHTMLコードの書き方も変化するので一つの取り出し方を書いてもすぐに無意味になってしまいます。どうやったらほしい情報を取り出せるか研究しないといけません。
実際、innerText で動かしてみると、”現在500円”とか”即決500円”なっています。文字列と数値が入り交ざっているのでこのままでいいならあまり複雑にならないのですが、数値だけほしい場合はこの中から取り出す工夫をしなければならないのでコードが複雑になってしまいました。もっといい方法があるような気がしますが、いまのところこれが限界でした。
以下が取得したデータから数値だけ取り出してシートに書き込むプロシージャになります。
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 |
Sub price1(ByRef obIE As Object) '現在の価格と即決の価格 Dim r_max As Long Dim genzai As String Dim sokket As String Dim i As Integer Dim n1 As Integer Dim n2 As Integer Dim n3 As Integer Dim objprice As Object '---------------------------------------------- For Each objprice In obIE.Document.getElementsByClassName("Product__priceInfo") n1 = InStr(objprice.outerText, "即決") n2 = InStr(objprice.outerText, "円") n3 = InStr(n2 + 1, objprice.outerText, "円") '確認---- 'Dim x As String 'Dim x2 As String 'x = objprice.outerText 'x = objprice.outerHTML 'MsgBox x 'x2 = objprice.innerText 'x2 = objprice.innerHTML 'MsgBox x2 '--- If Mid(objprice.outerText, 1, 2) = "現在" Then '即決があるか調べる If n1 > 0 Then '連続表記をそれぞれ二つに分ける genzai = Mid(objprice.outerText, 1, n1 - 1) sokket = Mid(objprice.outerText, n1, n3) Else '即決がなければ現在だけなので genzai = objprice.outerText sokket = "--" End If ElseIf Mid(objprice.outerText, 1, 2) = "即決" Then '現在があるか調べる n1 = InStr(objprice.outerText, "現在") If n1 > 0 Then '最初が即決なら現在は無いと規定できるので下の2行はいらない 'genzai = Mid(objprice.outerText, 1, n1 - 1) 'sokket = Mid(objprice.outerText, n1) Else genzai = "--" sokket = objprice.outerText End If End If '-------------------------------------------------- r_max = row_Max(3) '新規入力行位置をC列指定で取得 ActiveSheet.Cells(r_max, 3).Value = suujidake(genzai) ActiveSheet.Cells(r_max, 3).HorizontalAlignment = xlCenter ActiveSheet.Cells(r_max, 4).Value = suujidake(sokket) ActiveSheet.Cells(r_max, 4).HorizontalAlignment = xlCenter Next objprice End Sub |
このように obIE.Document.getElementsByClassNameや
objecIE.Document.getElementsByTagNameなどを使てデータを取得してそのデータを様々に加工し利用することができるのです。
データ転記の肝、ワークシートの新規入力行を知る
取得したデータをワークシートに書き込むために、シートのどの位置に書き込むか指定することが必要です
|
1 2 3 4 5 |
'現在のシートのデータを入れるべき最終行を返す Function row_Max(siteiRetu As Integer) As Long ' （2列目指定している↓） row_Max = ActiveSheet.Cells(Rows.Count, siteiRetu).End(xlUp).Row + 1 End Function |
row_Max = ActiveSheet.Cells(Rows.Count, siteiRetu).End(xlUp).Row + 1この一文が新規入力行の行位置を示します。
Cells(Rows.Count, siteiRetu)…第一引数はワークシートの行数、第二引数は列位置を指定します。
第二引数については、ワークシートに存在するデータベースの内データのある最終行をどの列に見るかを指定します。
最後に、リンクをあてる
|
1 2 3 4 5 6 7 8 9 10 11 12 13 |
Sub rinkhari(ByRef objIE As Object, str As String, gyou As Long) Dim ur As String 'URLをリンクする Dim anchor As HTMLAnchorElement For Each anchor In objIE.Document.Links If InStr(anchor.outerHTML, str) > 0 Then ur = anchor.href 'リンクを張る ActiveSheet.Hyperlinks.Add anchor:=ActiveSheet.Cells(gyou, 2), Address:=ur End If Next anchor End Sub |
最後に、以下に全部をコントロールするプロシージャを載せておきます。お役に立てるかわかりませんが、一生懸命頑張ってみました。どうぞよろしくお願いします！！！意味不明？？？
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 |
Sub titlset(ByRef objecIE As Object) Dim r_max As Long Dim objectag As Object Dim str As String Dim i As Integer Dim countcolec As Integer 'プログレスバーのフォームを開く UserForm1.Show Application.ScreenUpdating = False countcolec = objecIE.Document.getElementsByTagName("h3").Length '---------------------------------- i = 0 For Each objectag In objecIE.Document.getElementsByTagName("h3") If InStr(objectag.outerHTML, "title=""") > 0 Then r_max = row_Max(2) 'B列指定 'A列にインデックス番号を書き出す ActiveSheet.Cells(r_max, 1).Value = r_max - 9 'タイトル名を取り出す str = objectag.innerText ActiveSheet.Cells(r_max, 2).Value = str 'これ一行でOKです 'URLをリンクする rinkhari objecIE, str, r_max End If i = i + 1 'プログレスバーの進捗を更新表示 UserForm1.sinkou_val countcolec, i 'DoEvents Next objectag '現在の価格と即決価格をセット price1 objecIE 'その他の項目（otherInfo） otherinfo objecIE otherinfo2 objecIE '備考の項目 otherinfo3 objecIE '-------------------------------- 'プログレスバーを閉じる Unload UserForm1 Application.ScreenUpdating = True End Sub |
その他のVBAツールのご紹介
コメント
お世話になります。
WEBデータのスクレイピング記事ありがとうございました。
これは、「食べログ」でも実施すること可能でしょうか？
ご教授頂ければありがたいです。
どうぞ宜しくお願いします。
ブログを見ていただきありがとうございます。
このスクレイパーはヤフオク専用に作られています。
各種の検索サイトはそれぞれ独自のHTML構造を持っているので、そのサイトのHTMLファイルを調べた上で、どんな情報が欲しいのかに合わせてプログラムを変更する必要があります。
食べログのアドレスに変えてやってみると、サイトは表示されますが、検索結果は０でした。
食べログページでF12キーを押すとHTMLソースツールが表示するので、のぞいてみて下さい。
せっかく読んでいただいて質問してくださったのに、すっかり遅くなってごめんなさい。
今後とも鮎斗君をよろしくお願いします。