・インターネット上にデータを自動取得したい
・マクロを使ってwebのデータを取得したいが、やりかたが分からない…
・「VBAでIE操作」と聞いたことはあるが、いまいちピンとこない
私がエクセルマクロを勉強したころ、「VBAを使って、ウェブ情報をエクセルに書き出したい！」と思い、インターネットでいろいろと調べていました。しかし、詳しい情報は公開されていませんでした。今でも事例をもとにしたウェブデータ取得のIE操作の方法は、なかなか出回っていません。
そこで、この記事では、エクセルVBAでヤフオクの情報を取得して、エクセルに自動出力するマクロを紹介します。この記事を読めば、
・マクロをコピペすれば、そのまま使える
・コードを書き換えれば、あなたがやりたいことに転用できる
この記事で紹介するマクロは、エクセルファイルとしてダウンロードして使えるようにしています。このまま読みすすめていってください。
- VBAでIE操作！ヤフオクにアクセスし、取得した情報をエクセルへ
- エクセルマクロを使って、ヤフオク情報を取得するメリット
- VBAでIEに接続する前に準備しておくこと
- VBAでインターネットを操作｜ヤフオクに接続して、情報をスクレイピング
- ウェブからデータ取得｜DOMとInstr関数を抑えよ
- テンプレートをダウンロードしたい方はコチラから
- まずは試そう！実践しながら、できることを増やそう
VBAでIE操作！ヤフオクにアクセスし、取得した情報をエクセルへ
この記事でお伝えするのは、動画で紹介しているマクロ(VBAでIE操作 ヤフオクの情報を自動取得)です。
動画デモ : ヤフオクから情報を取得する (上の画像をクリックすると動画を再生します)
少し長いので、早送りでご覧ください。
エクセルマクロを使って、ヤフオク情報を取得するメリット
動画をご覧になった方は、ご理解いただけたと思いますが、ウェブから情報を取得し、エクセルに出力するマクロは、かなり強力です。その理由をいくつかお伝えします。
・価格が一覧になっており、カンタンに比較できる
・URLを取得すれば、エクセルにハイパーリンクを付けてページへアクセス
一つずつ紹介します。
ヤフオクに限らず、商品を探したり、データを取得するとき、マウスをクリックして、ウェブにアクセスして、画面に映る商品を見ながら、選んで・・・なんてやっていると、いつまで経っても、終わりませんよね。
しかし、マクロが自動で調べてくれるので、自分で一つ一つ調べる必要がなくなります。そうすれば、調べる時間を、丸々ほかのことに充てることができます。大切な時間を、優先順位の高いことに充てることができるのは、とても重要ですよね。
エクセルに出力すれば、カンタンに一覧にできます。一覧にしてしまえば、並び替えやフィルター機能を使って、価格の高い順に並べたり、残り時間の順番に並べたり、と様々な並べ替えが可能です。そうするだけで、分析の質は上がります。
ここでは、ヤフオクを事例にしていますが、ウェブから取得できる情報は、同じようにエクセルに一覧にできます。情報をイチイチ、マウスでコピペするのは、骨のおれる作業ですが、マクロで自動すれば、とてもラクになります。
ウェブ情報の場合は、気になったら、そのＵＲＬへアクセスして、詳しい情報を知りたい！なんてこともあるでしょう。
実際に、エクセルに出力するときに、ハイパーリンクを付けてアクセスすることもできます。こんなふうに要望があれば、柔軟に対応できてしまう。これが、エクセルマクロの強みです。
ここでは、ヤフオクを事例にしていますが、金融の情報など、毎日変化する情報を定期的に取得するのは、エクセルマクロで出来ます。あなたの大切な時間を節約するためにも、ぜひ知っておいていただければと思います。
この記事では、ヤフオクを事例にした情報取得マクロのコードを紹介しています。ぜひこのまま読み進めていってください。
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.分析のサマリーをエクセルへ出力
以下に、コードを記載しています。ぜひコピペして使ってみてください
Option Explicit Sub yahoo_auction_data_syutoku() Dim objIE As InternetExplorer Dim objtag, objsubmit, objtsugi As Object Dim cmax, s, z, i, k As Long Dim url As String Dim kirikae As Boolean Dim d As Date Dim ws1, ws2, ws3, ws4 As Worksheet Set ws1 = Worksheets("検索結果一覧") Set ws2 = Worksheets("結果出力") Set ws3 = Worksheets("設定") cmax = ws1.Range("C65536").End(xlUp).Row 'IE起動 Set objIE = CreateObject("InternetExplorer.Application") objIE.Visible = True url = ws3.Range("B2").Value For i = 7 To cmax If ws1.Range("G" & i).Value <> "分析済" Then s = ws1.Range("C" & i).Value ws2.Copy before:=ws2 Set ws4 = ActiveSheet ws4.Name = s ws4.Range("C2").Value = s Call access(objIE, url) Call kensaku(objIE, s) Call shuppin_su(objIE, ws4) '出品数を取得 kirikae = True '出品中を示す識別番号 For k = 0 To 5 Call title_s(objIE, ws4, kirikae) '最初のページを解析 If tsugihe(objIE) = False Then Exit For End If Next Call access(objIE, url) Call kensaku(objIE, s) kirikae = False '落札済を示す識別番号 Call rakusatsu_souba(objIE, ws4, kirikae) For k = 0 To 5 Call title_r(objIE, ws4, kirikae) If tsugihe(objIE) = False Then Exit For End If Next ws1.Range("D" & i).Value = ws4.Range("C5").Value ws1.Range("E" & i).Value = ws4.Range("D5").Value ws1.Range("F" & i).Value = Now ws1.Range("G" & i).Value = "分析済" End If Next objIE.Quit Set objIE = Nothing End Sub Sub access(ByRef objIE As Object, ByVal url As String) objIE.Navigate url Call IEWait(objIE) 'IEを待機 Call WaitFor(3) '3秒停止 End Sub Sub kensaku(ByRef objIE As Object, ByVal s As String) Dim objtag, objsubmit As Object For Each objtag In objIE.Document.getElementsByTagName("input") If InStr(objtag.outerHTML, """yschsp""") > 0 Then objtag.Value = s Exit For End If Next For Each objsubmit In objIE.Document.getElementsByTagName("input") If InStr(objsubmit.outerHTML, """検 索""") > 0 Then objsubmit.Click Call WaitFor(3) Exit For End If Next End Sub Sub shuppin_su(ByRef objIE As Object, ByVal ws4 As Worksheet) Dim objsubmit, objkensu As Object Dim n1, n2 As Long For Each objkensu In objIE.Document.getElementsByTagName("p") If InStr(objkensu.outerHTML, "class=""total""") > 0 Then n1 = InStr(objkensu.outerHTML, "<em>") n2 = InStr(objkensu.outerHTML, "</em>") ws4.Range("C5").Value = Mid(objkensu.outerHTML, n1 + 4, n2 - n1 - 4) Exit For End If Next End Sub Sub title_s(ByRef objIE As Object, ByVal ws4 As Worksheet, ByVal kirikae As String) Dim a, b, c, d, e, f As Long Dim objtag, objnyusatsu, objprice, objdate As Object Dim i, j, n1, n2, n3 As Long Dim d_t As Variant Dim s, ur As String For Each objtag In objIE.Document.getElementsByTagName("td") If InStr(objtag.outerHTML, "class=""a1""") > 0 Then Debug.Print objtag.innerHTML b = ws4.Range("B65536").End(xlUp).Row + 1 ws4.Range("A" & b).Value = b - 8 n1 = InStr(objtag.innerHTML, """ href=""") s = Mid(objtag.innerHTML, n1 + 2) Debug.Print s n2 = InStr(s, """>") n3 = InStr(s, "</a>") ws4.Range("B" & b).Value = Mid(s, n2 + 2, n3 - n2 - 2) 'URLをリンクする ur = Mid(s, 7, n2 - 7) Debug.Print ur ws4.Hyperlinks.Add anchor:=ws4.Range("B" & b), Address:=ur End If Next '現在の価格 For Each objprice In objIE.Document.getElementsByTagName("td") If InStr(objprice.outerHTML, """pr1""") > 0 Then c = ws4.Range("C65536").End(xlUp).Row + 1 n1 = InStr(objprice.outerHTML, """ePrice""") n2 = InStr(objprice.outerHTML, "円") ws4.Range("C" & c).Value = Replace(Mid(objprice.outerHTML, n1 + 17, n2 - n1 - 5), "</td>", "") End If Next '即決価格 For Each objprice In objIE.Document.getElementsByTagName("td") If InStr(objprice.outerHTML, """pr2""") > 0 Then d = ws4.Range("D65536").End(xlUp).Row + 1 If InStr(objprice.outerHTML, "<span>－</span>") > 0 Then ws4.Range("D" & d).Value = "なし" Else n1 = InStr(objprice.outerHTML, "pr2"">") n2 = InStr(objprice.outerHTML, "円") ws4.Range("D" & d).Value = Mid(objprice.outerHTML, n1 + 5, n2 - n1 - 4) End If End If Next For Each objnyusatsu In objIE.Document.getElementsByTagName("td") If InStr(objnyusatsu.outerHTML, "class=""bi"">") > 0 Then e = ws4.Range("E65536").End(xlUp).Row + 1 If InStr(objnyusatsu.outerHTML, "<span>－</span>") > 0 Then ws4.Range("E" & e).Value = "なし" Else n1 = InStrRev(objnyusatsu.outerHTML, """>") n2 = InStr(objnyusatsu.outerHTML, "</a>") ws4.Range("E" & e).Value = Mid(objnyusatsu.outerHTML, n1 + 2, n2 - n1 - 2) End If End If Next For Each objdate In objIE.Document.getElementsByTagName("td") If InStr(objdate.outerHTML, "class=""ti"">") > 0 Then Debug.Print objdate.innerHTML f = ws4.Range("F65536").End(xlUp).Row + 1 objdate.innerHTML = Replace(objdate.innerHTML, "<span>", "") objdate.innerHTML = Replace(objdate.innerHTML, "</span>", "") ws4.Range("F" & f).Value = objdate.innerHTML '備考欄→出品中or落札済 If kirikae = True Then ws4.Range("G" & f).Value = "出品中" Else ws4.Range("G" & f).Value = "落札済" End If End If Next End Sub Sub rakusatsu_souba(ByRef objIE As Object, ByVal ws2 As Worksheet, ByVal kirikae As String) Dim objsubmit, objkensu As Object Dim n1, n2 As Long For Each objsubmit In objIE.Document.getElementsByTagName("a") If InStr(objsubmit.outerHTML, "落札相場を調べる") > 0 Then objsubmit.Click Call WaitFor(3) Exit For End If Next For Each objkensu In objIE.Document.getElementsByTagName("p") If InStr(objkensu.outerHTML, "class=""total""") > 0 Then n1 = InStr(objkensu.outerHTML, "<em>") n2 = InStr(objkensu.outerHTML, "</em>") ws2.Range("D5").Value = Mid(objkensu.outerHTML, n1 + 4, n2 - n1 - 4) Exit For End If Next End Sub Sub title_r(ByRef objIE As Object, ByVal ws2 As Worksheet, ByVal kirikae As Boolean) Dim a, b, c, d, e As Long Dim objtag, objnyusatsu, objprice, objdate As Object Dim i, j, n1, n2, n3 As Long Dim d_t As Variant Dim s, ur As String For Each objtag In objIE.Document.getElementsByTagName("td") If InStr(objtag.outerHTML, "class=""a1""") > 0 Then Debug.Print objtag.innerHTML b = ws2.Range("B65536").End(xlUp).Row + 1 ws2.Range("A" & b).Value = b - 18 n1 = InStr(objtag.innerHTML, """ href=""") s = Mid(objtag.innerHTML, n1 + 2) Debug.Print s n2 = InStr(s, """>") n3 = InStr(s, "</h3>") ws2.Range("B" & b).Value = Mid(s, n2 + 2, n3 - n2 - 5) 'URLをリンクする ur = Mid(s, 7, n2 - 7) Debug.Print ur ws2.Hyperlinks.Add anchor:=ws2.Range("B" & b), Address:=ur End If Next For Each objprice In objIE.Document.getElementsByTagName("td") If InStr(objprice.outerHTML, "ePrice") > 0 Then c = ws2.Range("C65536").End(xlUp).Row + 1 n1 = InStr(objprice.outerHTML, "ePrice"">") n2 = InStr(objprice.outerHTML, "</span>") ws2.Range("C" & c).Value = Mid(objprice.outerHTML, n1 + 8, n2 - n1 - 8) n1 = InStr(objprice.outerHTML, "sPrice"">") n2 = InStrRev(objprice.outerHTML, "</span>") ws2.Range("D" & c).Value = Mid(objprice.outerHTML, n1 + 8, n2 - n1 - 8) End If Next For Each objnyusatsu In objIE.Document.getElementsByTagName("td") If InStr(objnyusatsu.outerHTML, "class=""bi"">") > 0 Then Debug.Print objnyusatsu.innerHTML d = ws2.Range("E65536").End(xlUp).Row + 1 n1 = InStrRev(objnyusatsu.outerHTML, """>") n2 = InStr(objnyusatsu.outerHTML, "</a>") ws2.Range("E" & d).Value = Mid(objnyusatsu.outerHTML, n1 + 2, n2 - n1 - 2) End If Next For Each objdate In objIE.Document.getElementsByTagName("td") If InStr(objdate.outerHTML, "class=""pr2"">") > 0 Then Debug.Print objdate.innerHTML e = ws2.Range("F65536").End(xlUp).Row + 1 n1 = InStr(objdate.innerHTML, "class=""d""") n2 = InStr(objdate.innerHTML, "</span>") d_t = Mid(objdate.innerHTML, n1 + 10, n2 - n1 - 10) n1 = InStr(objdate.innerHTML, "class=""t""") n2 = InStrRev(objdate.innerHTML, "</span>") d_t = d_t & " " & Mid(objdate.innerHTML, n1 + 10, n2 - n1 - 10) ws2.Range("F" & e).Value = d_t d_t = "" '備考欄→出品中or落札済 If kirikae = True Then ws2.Range("G" & e).Value = "出品中" Else ws2.Range("G" & e).Value = "落札済" End If End If 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 'IEを待機する関数 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
コードが長いので、細かい解説は省略します。
ここで紹介したコードを転用すれば、あなたのしたいことに合わせて、カスタマイズしながら使いまわせるはずです。ぜひ、活用してみてくださいね。
このマクロの情報は、2017/7/4に更新したもので、ヤフオクの仕様変更によって、正しく機能しなくなる場合がありますので、ご了承ください。
ウェブからデータ取得｜DOMとInstr関数を抑えよ
VBAでウェブからデータ取得するとき必要な知識はDOMとInstr関数です。
1.DOMという目印を使って、粗削りな情報を取得する
2.粗削りな情報をInstr関数を使って、見やすいカタチに整える
既にエクセルマクロが書けるのであれば、この2つを理解すれば、ウェブ情報の取得はそう難しいものではありません。ぜひ、詳しく勉強してみたいなら、こちらの教材がオススメです。
テンプレートをダウンロードしたい方はコチラから
今回紹介したエクセルファイルは、一から作るのは大変なので、今回作ったファイルは無料でダウンロードできるようにします。以下のフォームにメールアドレスを入力いただくと、返信メールからエクセルファイルをダウンロードできます。
ぜひご活用ください。
まずは試そう！実践しながら、できることを増やそう
いかがだったでしょうか？VBAを使って、ウェブデータを取得し、エクセルにリスト化する方法について、ヤフオクを事例にして、ご紹介しました。
今回、ご紹介したのをご覧になって、「難しいな」と感じたかもしれません。ここで取り扱っているマクロは、かなりの上級レベルですので、無理もないでしょう。
しかし、「こういう世界もあるのだなあ」と思っていただき、エクセルマクロの世界を味わっていただければ、何よりです。もし、「これはすごい！」とか「ここまで出来るようになってみたい！」、そんなふうに感じた方は、ぜひエクセルファイルをダウンロードして、ご自身の手でマクロを動かしてみてください。
私も今でこそ、VBAを使って、ウェブ情報を取得できるようになりましたが、最初は、マクロのコードを人からもらったり、写経しながら、うまく上達してきました。何事も、目で見るだけではなく、体験したことに勝るものはありません。
もし、ウェブ情報の取得をやってみたいのであれば、まずは試してみましょう。この記事では、エクセルファイルをダウンロードできるようにもしましたので、それをベースにチャレンジしてみるのもアリです。
ちょっと難しいから、少しカンタンなところから始めたい！というのであれば、こちらの無料動画から始めるのがオススメです。
VBAを使ったウェブ情報の取得ができるようになれば、エクセルマクロについては、かなりの上級者と言えます。ぜひあなたにもそのレベルになってもらえれば、と思います。
VBAでのIE操作のキホンを知りたいなら、こちらの記事がオススメです。
そもそもエクセルマクロVBAとは？とギモンに感じているなら、こちらの記事がオススメです。
次ページ 無職・派遣の男がたった1年で、仕事で年収100万アップし、海外プロジェクトリーダーに抜擢された「たった1つ」の方法とは？
