VBA練習問題
VBA100本ノック 100本目:WEBから100本ノックのリストを取得

VBAを100本の練習問題で鍛えます
最終更新日:2021-03-04

VBA100本ノック 100本目:WEBから100本ノックのリストを取得


WEBページから100本ノックのリストを取得する問題です。


ツイッター連動企画です。
ツイートでの見やすさを考慮して、ブック・シート指定等を適宜省略しています。

xlsmはご自身でご用意ください。


出題

出題ツイートへのリンク

#VBA100本ノック 100本目
以下のページにはVBA100本ノックのリストが掲載してあります。
https://excel-ubara.com/vba100sample/vba100list.html
この一覧を表形式でシートに出力してください。
方法不問。VBAで自動取得すれば良い。
※画像は出力例です。見栄えは任意、リンク不要

マクロ VBA 100本ノック


前記のURLは、本来のVBA100本ノックの目次ページとは別に作成したテスト用のページです。
VBAのテストでは、こちらのページをお使いください。
https://excel-ubara.com/vba100sample/vba100list.html


頂いた回答

解説

今なら真っ先にパワークエリを使いたくなると思いますし、回答でも多くありました。
このお題はやり方がかなり多く存在しますし、どれが良いかは好みもあると思います。
それならということで、昔からあるQueryTablesでやってみました。
tableを取得するだけならほとんど自動でやってくれます。

Sub VBA100_100_01()
  Const cnsURL = "https://excel-ubara.com/vba100sample/vba100list.html"
  
  Dim wb As Workbook: Set wb = ActiveWorkbook
  Dim ws As Worksheet: Set ws = wb.ActiveSheet
  ws.Cells.Clear
  
  With ws.QueryTables.Add(Connection:="URL;" & cnsURL, Destination:=ws.Range("A1"))
    .FieldNames = True
    .WebSelectionType = xlAllTables 'テーブルだけ
    .WebFormatting = xlWebFormattingNone 'xlWebFormattingAllならリンクも設定
    .Refresh BackgroundQuery:=False
    .Delete
  End With
  
  With ws.ListObjects.Add(xlSrcRange, ws.UsedRange, , xlYes)
    .Name = "TBL100LIST"
    .Range.EntireColumn.AutoFit
    .DataBodyRange.Columns(.ListColumns("出題日").Index).NumberFormatLocal = "yyyy/mm/dd"
  End With
End Sub


どの方法でやるかは、どのような使い方をする(多数のページを取得する等)かで適宜選択する必要があるでしょう。
記事補足には、パワークエリとIE操作による取得のVBAを掲載しました。


補足

やり方がかなり多く存在するので、代表的なパワークエリとIE操作だけを掲載しておきます。

パワークエリ
Sub VBA100_100_02()
  Const cnsURL = "https://excel-ubara.com/vba100sample/vba100list.html"
  Const cnsTBL = "VBA100LIST"
  
  Dim wb As Workbook: Set wb = ActiveWorkbook
  Dim ws As Worksheet: Set ws = wb.ActiveSheet
  ws.Cells.Clear
  
  wb.Queries.Add Name:=cnsTBL, Formula:= _
    "let ソース = Web.Page(Web.Contents(""" & cnsURL & """))," & _
    "Data0 = ソース{0}[Data]," & _
    "変更された型 = Table.TransformColumnTypes(Data0,{" & _
      "{""本数"", type text}," & _
      "{""出題日"", type date}," & _
      "{""出題ツイート"", type text}," & _
      "{""問題と解説記事"", type text}," & _
      "{""テスト用データ"", type text}}) in 変更された型"
  
  With ws.ListObjects.Add(SourceType:=0, _
    Source:="OLEDB;Provider=Microsoft.Mashup.OleDb.1;Data Source=$Workbook$;Location=""VBA100LIST""", _
    Destination:=ws.Range("$A$1")).QueryTable
    .CommandType = xlCmdSql
    .CommandText = "SELECT * FROM [" & cnsTBL & "]"
    .AdjustColumnWidth = True
    .Refresh BackgroundQuery:=False
  End With
  
  Call delQuerie(wb, cnsTBL)
End Sub

Sub delQuerie(ByVal wb As Workbook, ByVal aName As String)
  On Error Resume Next
  wb.Queries(aName).Delete
  On Error GoTo 0
End Sub

ほとんどは「マクロの記録」で作成されたVBAコードです。
そこから不要な部分を削除して整理しました。


IE操作
Sub VBA100_100_03()
  Dim st: st = Timer
  Const cnsURL = "https://excel-ubara.com/vba100sample/vba100list.html"
  
  Dim wb As Workbook: Set wb = ActiveWorkbook
  Dim ws As Worksheet: Set ws = wb.ActiveSheet
  
  Application.ScreenUpdating = False
  ws.Cells.Clear
  
  Dim objIE As New InternetExplorer
  objIE.Navigate cnsURL
  Call untilReady(objIE)
  
  Dim objHtml As HTMLDocument: Set objHtml = objIE.Document
  Dim objTable As Object: Set objTable = objHtml.getElementsByTagName("table")(0)
  Dim objTHead As Object: Set objTHead = objTable.getElementsByTagName("thead")(0)
  Dim objTBody As Object: Set objTBody = objTable.getElementsByTagName("tbody")(0)
  Dim objElm1 As Object, objElm2 As Object
  
  Dim i As Long, j As Long
  For Each objElm1 In objTHead.getElementsByTagName("tr")
    i = i + 1: j = 0
    For Each objElm2 In objElm1.getElementsByTagName("th")
      j = j + 1
      ws.Cells(i, j).Value = objElm2.innerText
    Next
  Next
  For Each objElm1 In objTBody.getElementsByTagName("tr")
    i = i + 1: j = 0
    For Each objElm2 In objElm1.getElementsByTagName("td")
      j = j + 1
      ws.Cells(i, j).Value = objElm2.innerText
    Next
  Next
  
  With ws.UsedRange
    .Borders.LineStyle = xlContinuous
    .EntireColumn.AutoFit
    .Columns(2).NumberFormatLocal = "yyyy/mm/dd"
  End With
  
  Set objIE = Nothing
  Application.ScreenUpdating = True
  Debug.Print Timer - st
End Sub

Sub untilReady(objIE As Object)
  Do While objIE.Busy = True Or objIE.ReadyState <> READYSTATE_COMPLETE
    DoEvents
  Loop
End Sub

指定のタグが無い場合等のエラー処理は入れていません。
必要に応じて、適宜エラー処理は追加してください。


サイト内関連ページ

PowerQueryの強力な機能をVBAから利用する方法
Excel2016より標準搭載されたPowerQueryはとても強力な機能ですが、使える環境が限られるので、頻繁に使われだすのはこれからになると思います。PowerQueryが広く使われだすと、色々な使い方が出てくると思います。ここでは、PowerQueryの優れた機能をVBAから利用する場合の手順を説明したものです。
WEBデータの取得方法
WEBページのデータを取得して、エクセルのデータとして取り込みたいとの要望が多いようです。マクロVBAでWEBページのデータを取得する方法はいろいろあります。QueryTables InternetExplorer MSHTML MSXML2 順番に、以下で説明します。
VBAでのInternetExplorer自動操作
VBAでInternetExplorerを操作する場合の基本について解説します。VBAでInternetExplorerを操作し、Webのデータを取得したり、リンクをクリックしたり、これらを自動で行う事が出来ます。定型的なブラウザ操作であれば、VBAで自動化することで大きな省力化になります。
VBAのスクレイピングを簡単楽にしてくれるSelenium
VBAでWebスクレイピングする方法としてIE自動操作がありますが、VBA記述が結構面倒になります、もっと簡単にスマートにVBAを書きたいと思ったら…SeleniumBasicを使ってみましょう。SeleniumBasicは、エクセルVBAでのWeb閲覧を自動化することを強力かつ簡単に実現してくれます。




同じテーマ「VBA100本ノック」の記事

93本目:複数ブックを連結して再分割
94本目:表範囲からHTMLのtableタグを作成
95本目:図形のテキストを検索するフォーム作成
96本目:Accessデータを取得(マスタ結合&抽出)
97本目:Accessデータを取得(グループ集計)
98本目:席替えルールが守られているか確認
99本目:自動席替え(行列と前後左右が全て違うように)
100本目:WEBから100本ノックのリストを取得
魔球編:組み合わせ問題
魔球編:閉領域の塗り潰し
迷宮編:巡回セル問題


新着記事NEW ・・・新着記事一覧を見る

PropertyのSetはLetでも良い|VBA技術解説(2021-03-31)
エクセル麻雀ミニゲーム|VBAサンプル集(2021-03-09)
VBA100本ノック 100本目:WEBから100本ノックのリストを取得|VBA練習問題(2021-03-03)
VBA100本ノック 魔球編:2桁の最小公倍数|VBA練習問題(2021-02-02)
Select Caseでの短絡評価(ショートサーキット)の使い方|VBA技術解説(2021-01-03)
VBA100本ノック 迷宮編:巡回セル問題|VBA練習問題(2020-12-31)
VBA100本ノック 魔球編:閉領域の塗り潰し|VBA練習問題(2020-12-16)
VBA100本ノック 魔球編:組み合わせ問題|VBA練習問題(2020-12-02)
将棋とプログラミングについて~そこには型がある~|エクセル雑感(2020-11-22)
VBA100本ノック 1本目:セルのコピー|VBA練習問題(2020-10-19)


アクセスランキング ・・・ ランキング一覧を見る

1.最終行の取得(End,Rows.Count)|VBA入門
2.RangeとCellsの使い方|VBA入門
3.変数宣言のDimとデータ型|VBA入門
4.マクロって何?VBAって何?|VBA入門
5.Excelショートカットキー一覧|Excelリファレンス
6.繰り返し処理(For Next)|VBA入門
7.Range以外の指定方法(Cells,Rows,Columns)|VBA入門
8.セルのコピー&値の貼り付け(PasteSpecial)|VBA入門
9.セルに文字を入れるとは(Range,Value)|VBA入門
10.とにかく書いてみよう(Sub,End Sub)|VBA入門




このサイトがお役に立ちましたら「シェア」「Bookmark」をお願いいたします。


記述には細心の注意をしたつもりですが、
間違いやご指摘がありましたら、「お問い合わせ」からお知らせいただけると幸いです。
掲載のVBAコードは動作を保証するものではなく、あくまでVBA学習のサンプルとして掲載しています。
掲載のVBAコードは自己責任でご使用ください。万一データ破損等の損害が発生しても責任は負いません。



このサイトがお役に立ちましたら「シェア」「Bookmark」をお願いいたします。
本文下部へ