・インターネット上にデータを自動取得したい
・マクロを使ってwebのデータを取得したいが、やりかたが分からない…
・「VBAでIE操作」と聞いたことはあるが、いまいちピンとこない
この記事では、エクセルVBAでヤフオクの情報を取得して、エクセルに自動出力するマクロを紹介します。
・マクロをコピペすれば、そのまま使える
この記事で紹介するマクロは、エクセルファイルとしてダウンロードして使えるようにしています。
目次
VBAでHTTPリクエストを使ってヤフオク情報を取得
別ページでHTTPリクエスト型に書き換えました。HTTPリクエストで行う方が速度が速いです。
詳しくは以下をご覧ください。
VBAでIE操作！ヤフオクにアクセスし、取得した情報をエクセルへ
この記事でお伝えするのは、動画で紹介しているマクロ(VBAでIE操作 ヤフオクの情報を自動取得)です。
動画デモ : ヤフオクから情報を取得する (上の画像をクリックすると動画を再生します)
少し長いので、早送りでご覧ください。
エクセルマクロを使って、ヤフオク情報を取得するメリット
動画をご覧になった方は、ご理解いただけたと思いますが、ウェブから情報を取得し、エクセルに出力するマクロは、かなり強力です。その理由をいくつかお伝えします。
・価格が一覧になっており、カンタンに比較できる
・URLを取得すれば、エクセルにハイパーリンクを付けてページへアクセス
一つずつ紹介します。
1.自分で一つ一つ調べる必要がない
ヤフオクに限らず、商品を探したり、データを取得するとき、マウスをクリックして、ウェブにアクセスして、画面に映る商品を見ながら、選んで・・・なんてやっていると、いつまで経っても、終わりませんよね。
しかし、マクロが自動で調べてくれるので、自分で一つ一つ調べる必要がなくなります。そうすれば、調べる時間を、丸々ほかのことに充てることができます。大切な時間を、優先順位の高いことに充てることができるのは、とても重要ですよね。
エクセルに出力すれば、カンタンに一覧にできます。一覧にしてしまえば、並び替えやフィルター機能を使って、価格の高い順に並べたり、残り時間の順番に並べたり、と様々な並べ替えが可能です。そうするだけで、分析の質は上がります。
ここでは、ヤフオクを事例にしていますが、ウェブから取得できる情報は、同じようにエクセルに一覧にできます。情報をイチイチ、マウスでコピペするのは、骨のおれる作業ですが、マクロで自動すれば、とてもラクになります。
ウェブ情報の場合は、気になったら、そのＵＲＬへアクセスして、詳しい情報を知りたい！なんてこともあるでしょう。
実際に、エクセルに出力するときに、ハイパーリンクを付けてアクセスすることもできます。こんなふうに要望があれば、柔軟に対応できてしまう。これが、エクセルマクロの強みです。
ここでは、ヤフオクを事例にしていますが、金融の情報など、毎日変化する情報を定期的に取得するのは、エクセルマクロで出来ます。あなたの大切な時間を節約するためにも、ぜひ知っておいていただければと思います。
この記事では、ヤフオクを事例にした情報取得マクロのコードを紹介しています。ぜひこのまま読み進めていってください。
VBAでIEに接続する前に準備しておくこと
エクセルVBAでIEを操作するためのプログラミングに入る前に、準備しておくことがあります。
準備｜VBEで参照設定でInternetExplorer型を追加
参照設定にチェックを入れて、IE操作できるようにします。
以下の2つを「参照設定」でライブラリを追加する必要があります。やり方は、以下のとおりです
1.VBEを開いて頂いて、「ツール」→「参照設定」
2.この二つのライブラリにチェックを入れて、OKをクリック
・Microsoft HTML Object Library
・Microsoft Internet Controls
詳細はこちらの画像の通りです。
・Microsoft HTML Object Library
・Microsoft Internet Controls
これで、ウェブ操作するマクロを動かせるようになります。
VBAでインターネットを操作｜ヤフオクに接続して、情報をスクレイピング
それでは、コードを紹介します。このコードでは、
2.あらかじめ入力しておいた「検索したいワード」でヤフオク検索
3.出品中の商品の情報を「価格」「入札数」「終了日」をエクセルへ出力
4.落札された商品の情報を「落札価格」「入札数」「終了日」をエクセルへ出力
5.分析のサマリーをエクセルへ出力
以下に、コードを記載しています。ぜひコピペして使ってみてください
ただし、以下のコードは2020年5月4日時点で動くことを確認していますが、お使いのPCのOSやIEのバージョンによっては動作しない場合があります。
またヤフオクそのものがアップデートされると動作しなくなる可能性もあります。
以上を理解した上で活用ください。
|
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 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 |
Option Explicit Sub Yahoo_auction_data_syutoku() '変数設定 Dim ObjIE As InternetExplorer Dim ObjTag As Object, ObjsSbmit As Object, ObjTsugi As Object Dim Cnt As Long, z As Long, i As Long, k As Long Dim Url As String, s As String Dim Kirikae As Boolean Dim d As Date Dim ws1 As Worksheet, ws2 As Worksheet, ws3 As Worksheet, ws4 As Worksheet Dim ws As Worksheet 'ワークシートの設定 Set ws1 = Worksheets("検索キーワード") Set ws2 = Worksheets("結果出力") Set ws3 = Worksheets("設定") 'Internet Explorer起動 Set ObjIE = CreateObject("InternetExplorer.Application") 'Internet ExplorerをPC画面上に見えるように設定 ObjIE.Visible = True '変数UrlにヤフオクのURLを入れる（シート「設定」のセルB2） Url = ws3.Range("B2").Value '変数sに検索キーワードを入れる（シート「検索キーワード」のセルC6） s = ws1.Range("C6").Value '変数sがシート名と一緒になっていないことをチェック If s = "検索キーワード" Or s = "結果出力" Or s = "設定" Then MsgBox "検索キーワードがシート名と同じです" Exit Sub End If '同じ検索キーワードのシートがあれば、そのシートを削除 For Each ws In Worksheets If ws.Name = s Then Application.DisplayAlerts = False ws.Delete Application.DisplayAlerts = True End If Next 'シート「結果出力」をコピーして、コピーしてシート名を検索キーワードにする ws2.Copy before:=ws2 Set ws4 = ActiveSheet ws4.Activate ws4.Name = s '検索キーワードをセルC2に入れる ws4.Range("C2").Value = s 'ヤフオクにアクセスして検索する関数を呼び出す Call Kensaku(ObjIE, Url, s) '出品数を取得 ws4.Range("C4").Value = Shuppin_su(ObjIE, ws4, s) '出品数を20で割ったときの商を出すことで、「次へ」を何回クリックするか算出する Cnt = 1 + ws4.Range("C4").Value \ 20 '出品中をTrueで識別 Kirikae = True 'ヤフオクの出品ページを全て習得する For k = 0 To Cnt Call Title_s(ObjIE, ws4, Kirikae) If Tsugihe(ObjIE) = False Then Exit For End If Next '落札済をFalseで識別 Kirikae = False '落札済みの件数を取得 ws4.Range("C5").Value = Rakusatsu_Souba(ObjIE, ws4, s) '落札数を20で割ったときの商を出すことで、「次へ」を何回クリックするか算出する Cnt = 1 + ws4.Range("C5").Value \ 20 'ヤフオクの落札済ページを全て習得する For k = 0 To Cnt Call Title_r(ObjIE, ws4, Kirikae) If Tsugihe(ObjIE) = False Then Exit For End If Next 'このプログラムを動かした日時を入れる ws4.Range("E5").Value = Now 'Internet Explorerを閉じる ObjIE.Quit 'Internet Explorerオブジェクトの解放 Set ObjIE = Nothing End Sub 'ヤフオクにアクセスして、キーワードで検索する Sub Kensaku(ByRef ObjIE As Object, ByVal Url As String, ByVal s As String) 'ヤフオクにアクセスする ObjIE.Navigate Url 'Internet Explorerでウェブページを読み込む Call IEWait(ObjIE) '3秒停止 Call WaitFor(3) 'ヤフオクの検索テキストボックスにキーワードを入れる ObjIE.Document.getElementById("yschsp").Value = s 'ヤフオクの検索ボタンをクリックする ObjIE.Document.getElementById("acHdSchBtn").Click 'Internet Explorerでウェブページを読み込む Call IEWait(ObjIE) '3秒停止 Call WaitFor(3) End Sub '検索キーワードの出品数をカウントする Function Shuppin_su(ByRef ObjIE As Object, ByVal ws4 As Worksheet, ByVal s As String) Dim Shuppin As String Shuppin = ObjIE.Document.getElementsByClassName("Tab__subText")(0).innerText Shuppin = Replace(Shuppin, "件", "") Shuppin_su = Shuppin End Function Sub Title_s(ByRef ObjIE As Object, ByVal ws4 As Worksheet, ByVal Kirikae As String) Dim a As Long, b As Long, c As Long, d As Long, cmax As Long, f As Long, g As Long Dim ObjTag As Object, ObjNyusatsu As Object Dim ObjPrice As Object, ObjPrice2, ObjDate As Object Dim i As Long, j As Long, n1 As Long, n2 As Long, n3 As Long Dim d_t As Variant Dim s As String, ur As String, Sokketsu As String, Kaishi As String cmax = ws4.Range("F1048576").End(xlUp).Row + 1 For Each ObjTag In ObjIE.Document.getElementsByClassName("Product__titleLink") If InStr(ObjTag.outerHTML, """ target=""_blank""") > 0 Then n1 = InStr(ObjTag.outerHTML, "href=""https://") n2 = InStr(ObjTag.outerHTML, """ target=""_blank""") s = Mid(ObjTag.outerHTML, n1 + 6, n2 - n1 - 6) Debug.Print s b = ws4.Range("B1048576").End(xlUp).Row + 1 ws4.Range("A" & b).Value = b - 7 ws4.Range("B" & b).Value = ObjTag.innerText ws4.Hyperlinks.Add anchor:=ws4.Range("B" & b), Address:=s '備考欄→出品中or落札済 If Kirikae = True Then ws4.Range("C" & b).Value = "出品中" Else ws4.Range("C" & b).Value = "落札済" End If End If Next '現在と即決の価格 For Each ObjPrice In ObjIE.Document.getElementsByClassName("Product__priceInfo") '現在価格のみの場合 If InStr(ObjPrice.innerText, "現在") > 0 And InStr(ObjPrice.innerText, "即決") = 0 Then ws4.Range("D" & cmax).Value = Replace(ObjPrice.innerText, "現在", "") '即決価格のみの場合 ElseIf InStr(ObjPrice.innerText, "現在") = 0 And InStr(ObjPrice.innerText, "即決") > 0 Then ws4.Range("E" & cmax).Value = Replace(ObjPrice.innerText, "即決", "") '現在価格と即決価格の両方がある場合 Else n3 = InStr(ObjPrice.innerText, " 即") Debug.Print ObjPrice.innerText Kaishi = Mid(ObjPrice.innerText, 1, Len(ObjPrice.innerText) - n3) Kaishi = Replace(Kaishi, " ", "") Kaishi = Replace(Kaishi, "即決", "") ws4.Range("D" & cmax).Value = Replace(Kaishi, "現在", "") Sokketsu = Mid(ObjPrice.innerText, n3) Sokketsu = Replace(Sokketsu, " ", "") ws4.Range("E" & cmax).Value = Replace(Sokketsu, "即決", "") End If cmax = cmax + 1 Next '入札数 For Each ObjNyusatsu In ObjIE.Document.getElementsByClassName("Product__bid") f = ws4.Range("F1048576").End(xlUp).Row + 1 ws4.Range("F" & f).Value = ObjNyusatsu.innerText Next '残り時間 For Each ObjDate In ObjIE.Document.getElementsByClassName("Product__time") g = ws4.Range("G1048576").End(xlUp).Row + 1 ws4.Range("G" & g).Value = ObjDate.innerText Next End Sub Function Rakusatsu_Souba(ByRef ObjIE As Object, ByVal ws4 As Worksheet, ByVal s As String) Dim ObjSubmit As Object For Each ObjSubmit In ObjIE.Document.getElementsByTagName("a") If InStr(ObjSubmit.outerHTML, "落札相場を調べる") > 0 Then ObjSubmit.Click Call WaitFor(3) Exit For End If Next Dim Rakusatsu As String Rakusatsu = ObjIE.Document.getElementsByClassName("SearchMode__title")(0).innerText Rakusatsu = Replace(Rakusatsu, "過去120日間に落札された商品 ", "") Rakusatsu = Replace(Rakusatsu, "件", "") Rakusatsu_Souba = Rakusatsu End Function Sub Title_r(ByRef ObjIE As Object, ByVal ws4 As Worksheet, ByVal Kirikae As Boolean) Dim a As Long, b As Long, c As Long, d As Long, e As Long, f As Long, g As Long Dim ObjTag As Object, ObjNyusatsu As Object Dim ObjPrice As Object, ObjPrice2, ObjDate As Object Dim i As Long, j As Long, n1 As Long, n2 As Long, n3 As Long Dim d_t As Variant Dim s As String, ur As String For Each ObjTag In ObjIE.Document.getElementsByClassName("Product__titleLink") If InStr(ObjTag.outerHTML, "titleLink"" href=""") > 0 Then n1 = InStr(ObjTag.outerHTML, "href=""https://") n2 = InStr(ObjTag.outerHTML, "data-ylk=""") s = Mid(ObjTag.outerHTML, n1 + 6, n2 - n1 - 8) Debug.Print s b = ws4.Range("B1048576").End(xlUp).Row + 1 ws4.Range("A" & b).Value = b - 7 ws4.Range("B" & b).Value = ObjTag.innerText ws4.Hyperlinks.Add anchor:=ws4.Range("B" & b), Address:=s '備考欄→出品中or落札済 If Kirikae = True Then ws4.Range("C" & b).Value = "出品中" Else ws4.Range("C" & b).Value = "落札済" End If End If Next '開始価格 For Each ObjPrice In ObjIE.Document.getElementsByClassName("u-fontSize14 u-textGray") d = ws4.Range("D1048576").End(xlUp).Row + 1 ws4.Range("D" & d).Value = ObjPrice.innerText Next '落札価格 For Each ObjPrice2 In ObjIE.Document.getElementsByClassName("Product__priceValue") e = ws4.Range("E1048576").End(xlUp).Row + 1 ws4.Range("E" & e).Value = ObjPrice2.innerText Next '入札数 For Each ObjNyusatsu In ObjIE.Document.getElementsByClassName("Product__bid") f = ws4.Range("F1048576").End(xlUp).Row + 1 ws4.Range("F" & f).Value = ObjNyusatsu.innerText Next '残り時間 For Each ObjDate In ObjIE.Document.getElementsByClassName("Product__time") g = ws4.Range("G1048576").End(xlUp).Row + 1 ws4.Range("G" & g).Value = ObjDate.innerText Next End Sub 'ウェブページ内の「次へ」を自動クリックする関数 Function Tsugihe(ByRef ObjIE As Object) As Boolean Dim ObjSubmit As Object For Each ObjSubmit In ObjIE.Document.getElementsByTagName("a") If InStr(ObjSubmit.outerHTML, "次へ") > 0 Then ObjSubmit.Click Call WaitFor(3) Tsugihe = True Exit For End If Tsugihe = False Next End Function 'Internet Explorerがウェブページを読み込むまで待機する関数 Function IEWait(ByRef ObjIE As Object) Do While ObjIE.Busy = True Or ObjIE.ReadyState <> 4 DoEvents Loop End Function '指定した秒だけ停止する関数 Function WaitFor(ByVal second As Integer) Dim futureTime As Date futureTime = DateAdd("s", second, Now) While Now < futureTime DoEvents Wend End Function </span></span></span> |
コードが長いので、細かい解説は省略します。
ここで紹介したコードを転用すれば、あなたのしたいことに合わせて、カスタマイズしながら使いまわせるはずです。ぜひ、活用してみてくださいね。
このマクロの情報は、2017/7/4に更新したもので、ヤフオクの仕様変更によって、正しく機能しなくなる場合がありますので、ご了承ください。
ウェブからデータ取得｜DOMとInstr関数を抑えよ
VBAでウェブからデータ取得するとき必要な知識はDOMとInstr関数です。
1.DOMという目印を使って、粗削りな情報を取得する
2.粗削りな情報をInstr関数を使って、見やすいカタチに整える
既にエクセルマクロが書けるのであれば、この2つを理解すれば、ウェブ情報の取得はそう難しいものではありません。ぜひ、詳しく勉強してみたいなら、こちらの教材がオススメです。
テンプレートをダウンロードしたい方はコチラから
今回紹介したエクセルファイルは、一から作るのは大変なので、今回作ったファイルは無料でダウンロードできるようにします。以下のフォームにメールアドレスを入力いただくと、返信メールからエクセルファイルをダウンロードできます。
ぜひご活用ください。
まずは試そう！実践しながら、できることを増やそう
いかがだったでしょうか？VBAを使って、ウェブデータを取得し、エクセルにリスト化する方法について、ヤフオクを事例にして、ご紹介しました。
今回、ご紹介したのをご覧になって、「難しいな」と感じたかもしれません。ここで取り扱っているマクロは、かなりの上級レベルですので、無理もないでしょう。
しかし、「こういう世界もあるのだなあ」と思っていただき、エクセルマクロの世界を味わっていただければ、何よりです。もし、「これはすごい！」とか「ここまで出来るようになってみたい！」、そんなふうに感じた方は、ぜひエクセルファイルをダウンロードして、ご自身の手でマクロを動かしてみてください。
私も今でこそ、VBAを使って、ウェブ情報を取得できるようになりましたが、最初は、マクロのコードを人からもらったり、写経しながら、うまく上達してきました。何事も、目で見るだけではなく、体験したことに勝るものはありません。
もし、ウェブ情報の取得をやってみたいのであれば、まずは試してみましょう。この記事では、エクセルファイルをダウンロードできるようにもしましたので、それをベースにチャレンジしてみるのもアリです。
ちょっと難しいから、少しカンタンなところから始めたい！というのであれば、こちらの無料動画から始めるのがオススメです。
VBAを使ったウェブ情報の取得ができるようになれば、エクセルマクロについては、かなりの上級者と言えます。ぜひあなたにもそのレベルになってもらえれば、と思います。
VBAでのIE操作のキホンを知りたいなら、こちらの記事がオススメです。
