パソコンスキル教科書

パソコンスキルの教科書

東京大学大学院卒。博士課程に進学を志すも、担当教授と折が合わず、無職になる。医者を目指すも結局断念。田舎で派遣社員として働く。「スキルがなければ、仕事ももらえない」と悟り、ビジネススキルを学ぶ。プログラミング、英語を学び、一部上場企業へ転職。年間100時間以上の業務効率化を行い、社内講師に抜擢。海外の案件を担当し、数億円のプロジェクトに携わる。個人の事業でも、月売上100万を達成。現在は、自分の価値を高めるためのスキル向上支援を行う

VBAでヤフオクのデータを取得しExcelへ出力!IE操作マクロのテンプレート付

f:id:gene320:20170705000545p:plain

・インターネット上にデータを自動取得したい
・マクロを使ってwebのデータを取得したいが、やりかたが分からない…
・「VBAでIE操作」と聞いたことはあるが、いまいちピンとこない

私がエクセルマクロを勉強したころ、「VBAを使って、ウェブ情報をエクセルに書き出したい!」と思い、インターネットでいろいろと調べていました。しかし、詳しい情報は公開されていませんでした。今でも事例をもとにしたウェブデータ取得のIE操作の方法は、なかなか出回っていません。

そこで、この記事では、エクセルVBAでヤフオクの情報を取得して、エクセルに自動出力するマクロを紹介します。この記事を読めば、

・ウェブから情報を取得する方法を具体的に理解できる
・マクロをコピペすれば、そのまま使える
・コードを書き換えれば、あなたがやりたいことに転用できる

この記事で紹介するマクロは、エクセルファイルとしてダウンロードして使えるようにしています。このまま読みすすめていってください。

エクセルマクロでヤフオクの情報を取得してExcelへ出力!ダウンロードできるテンプレート付

VBAでIE操作!ヤフオクにアクセスし、取得した情報をエクセルへ

この記事でお伝えするのは、動画で紹介しているマクロ(VBAでIE操作 ヤフオクの情報を自動取得)です。


動画デモ : ヤフオクから情報を取得する (上の画像をクリックすると動画を再生します)

少し長いので、早送りでご覧ください。

エクセルマクロを使って、ヤフオク情報を取得するメリット

動画をご覧になった方は、ご理解いただけたと思いますが、ウェブから情報を取得し、エクセルに出力するマクロは、かなり強力です。その理由をいくつかお伝えします。

・自分で一つ一つ調べる必要がない
・価格が一覧になっており、カンタンに比較できる
・URLを取得すれば、エクセルにハイパーリンクを付けてページへアクセス

一つずつ紹介します。

1.自分で一つ一つ調べる必要がない

ヤフオクに限らず、商品を探したり、データを取得するとき、マウスをクリックして、ウェブにアクセスして、画面に映る商品を見ながら、選んで・・・なんてやっていると、いつまで経っても、終わりませんよね。

しかし、マクロが自動で調べてくれるので、自分で一つ一つ調べる必要がなくなります。そうすれば、調べる時間を、丸々ほかのことに充てることができます。大切な時間を、優先順位の高いことに充てることができるのは、とても重要ですよね。

2.価格が一覧になっており、カンタンに比較できる

エクセルに出力すれば、カンタンに一覧にできます。一覧にしてしまえば、並び替えやフィルター機能を使って、価格の高い順に並べたり、残り時間の順番に並べたり、と様々な並べ替えが可能です。そうするだけで、分析の質は上がります。

ここでは、ヤフオクを事例にしていますが、ウェブから取得できる情報は、同じようにエクセルに一覧にできます。情報をイチイチ、マウスでコピペするのは、骨のおれる作業ですが、マクロで自動すれば、とてもラクになります。

3.URLを取得すれば、エクセルにハイパーリンクを付けてページへアクセス

ウェブ情報の場合は、気になったら、そのURLへアクセスして、詳しい情報を知りたい!なんてこともあるでしょう。

実際に、エクセルに出力するときに、ハイパーリンクを付けてアクセスすることもできます。こんなふうに要望があれば、柔軟に対応できてしまう。これが、エクセルマクロの強みです。

ここでは、ヤフオクを事例にしていますが、金融の情報など、毎日変化する情報を定期的に取得するのは、エクセルマクロで出来ます。あなたの大切な時間を節約するためにも、ぜひ知っておいていただければと思います。

この記事では、ヤフオクを事例にした情報取得マクロのコードを紹介しています。ぜひこのまま読み進めていってください。

VBAでIEに接続する前に準備しておくこと

エクセルVBAでIEを操作するためのプログラミングに入る前に、準備しておくことがあります。

準備|VBEで参照設定でInternetExplorer型を追加

参照設定にチェックを入れて、IE操作できるようにします。

以下の2つを「参照設定」でライブラリを追加する必要があります。やり方は、以下のとおりです

設定方法

1.VBEを開いて頂いて、「ツール」→「参照設定」
2.この二つのライブラリにチェックを入れて、OKをクリック
・Microsoft HTML Object Library
・Microsoft Internet Controls

詳細はこちらの画像の通りです。

1.VBEを開いて頂いて、「ツール」→「参照設定」

f:id:gene320:20170613213650p:plain

2.ライブラリ(以下の2つ)にチェックし、OKをクリック

・Microsoft HTML Object Library
・Microsoft Internet Controls

f:id:gene320:20170613213737p:plain

これで、ウェブ操作するマクロを動かせるようになります。

VBAでインターネットを操作|ヤフオクに接続して、情報をスクレイピング

それでは、コードを紹介します。このコードでは、

1.インターネットに接続して、ヤフオクのページを開く
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つを理解すれば、ウェブ情報の取得はそう難しいものではありません。ぜひ、詳しく勉強してみたいなら、こちらの教材がオススメです。

テンプレートをダウンロードしたい方はコチラから

今回紹介したエクセルファイルは、一から作るのは大変なので、今回作ったファイルは無料でダウンロードできるようにします。以下のフォームにメールアドレスを入力いただくと、返信メールからエクセルファイルをダウンロードできます。

" width="640" height="720" frameborder="0" marginheight="0" marginwidth="0">読み込んでいます...

ぜひご活用ください。

まずは試そう!実践しながら、できることを増やそう

いかがだったでしょうか?VBAを使って、ウェブデータを取得し、エクセルにリスト化する方法について、ヤフオクを事例にして、ご紹介しました。

今回、ご紹介したのをご覧になって、「難しいな」と感じたかもしれません。ここで取り扱っているマクロは、かなりの上級レベルですので、無理もないでしょう。

しかし、「こういう世界もあるのだなあ」と思っていただき、エクセルマクロの世界を味わっていただければ、何よりです。もし、「これはすごい!」とか「ここまで出来るようになってみたい!」、そんなふうに感じた方は、ぜひエクセルファイルをダウンロードして、ご自身の手でマクロを動かしてみてください。

私も今でこそ、VBAを使って、ウェブ情報を取得できるようになりましたが、最初は、マクロのコードを人からもらったり、写経しながら、うまく上達してきました。何事も、目で見るだけではなく、体験したことに勝るものはありません

もし、ウェブ情報の取得をやってみたいのであれば、まずは試してみましょう。この記事では、エクセルファイルをダウンロードできるようにもしましたので、それをベースにチャレンジしてみるのもアリです。

ちょっと難しいから、少しカンタンなところから始めたい!というのであれば、こちらの無料動画から始めるのがオススメです。

VBAを使ったウェブ情報の取得ができるようになれば、エクセルマクロについては、かなりの上級者と言えます。ぜひあなたにもそのレベルになってもらえれば、と思います。

VBAでのIE操作のキホンを知りたいなら、こちらの記事がオススメです。

www.fastclassinfo.com

そもそもエクセルマクロVBAとは?とギモンに感じているなら、こちらの記事がオススメです。

www.fastclassinfo.com