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

最終更新日：2021-03-04

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

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

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

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

出題

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

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

VBA作成タイム

この下に頂いた回答へのリンクと解説を掲載しています。
途中まででも良いので、できるだけ自分でVBAを書いてみましょう。

他の人の回答および解説を見て、書いたVBAを見直してみましょう。

頂いた回答

出題ツイートの引用ツイートでの回答

解説

今なら真っ先にパワークエリを使いたくなると思いますし、回答でも多くありました。
このお題はやり方がかなり多く存在しますし、どれが良いかは好みもあると思います。
それならということで、昔からある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から利用する方法

・説明に使用するデータ・PowerQueryの操作方法・PowerQueryのマクロの記録・PowerQueryのVBA文法・PowerQueryの機能を利用したマクロVBA ・PowerQueryについて

WEBデータの取得方法

・サンプルページ・QueryTables ・InternetExplorer ・MSHTML ・MSXML2 ・WEBデータの取得方法の最後に

VBAでのInternetExplorer自動操作

・VBEの参照設定・InternetExplorerの開始と終了・HTMLオブジェクトの操作・VBAでのInternetExplorer操作例・WEBクローリング&スクレイピングのサイト内参考ページ

VBAのスクレイピングを簡単楽にしてくれるSelenium

・SeleniumBasicのインストール・VBEでの参照設定・WEBサイトを表示してみましょう・Seleniumの基本的な使い方（株価情報を取得してみる）・色々なパターンでのseleniumの使い方・色々組み合わせて目的の画面にたどり着きます・elementをコレクションで取得する・新規ページが開かれる場合・上手くいかない特殊な場合の対処方法・Seleniumの実践例例・最後に

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

95本目：図形のテキストを検索するフォーム作成
 96本目：Accessデータを取得（マスタ結合&抽出）
97本目：Accessデータを取得（グループ集計）
98本目：席替えルールが守られているか確認
 99本目：自動席替え（行列と前後左右が全て違うように）
100本目：WEBから100本ノックのリストを取得
魔球編：組み合わせ問題
 魔球編：閉領域の塗り潰し
 迷宮編：巡回セル問題
 魔球編：2桁の最小公倍数
 参加者様ご紹介

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

1.最終行の取得（End,Rows.Count）｜VBA入門
2.RangeとCellsの使い方｜VBA入門
3.繰り返し処理（For Next)｜VBA入門
4.変数宣言のDimとデータ型｜VBA入門
5.セルのコピー&値の貼り付け（PasteSpecial）｜VBA入門
6.マクロとは？VBAとは？VBAでできること｜VBA入門
7.ブックを閉じる・保存（Close,Save,SaveAs）｜VBA入門
8.並べ替え（Sort）｜VBA入門
9.Range以外の指定方法（Cells,Rows,Columns）｜VBA入門
10.条件分岐（IF）｜VBA入門

ホーム
マクロVBA入門編
VBA100本ノック
100本目：WEBから100本ノックのリストを取得

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

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

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