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

公開日：2021-03-03　最終更新日：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本ノック」の記事

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

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

1.最終行の取得（End,Rows.Count）｜VBA入門
2.日本の祝日一覧｜Excelリファレンス
3.変数宣言のDimとデータ型｜VBA入門
4.FILTER関数（範囲をフィルター処理）｜エクセル入門
5.RangeとCellsの使い方｜VBA入門
6.繰り返し処理（For Next)｜VBA入門
7.セルのコピー&値の貼り付け（PasteSpecial）｜VBA入門
8.マクロとは？VBAとは？VBAでできること｜VBA入門
9.セルのクリア（Clear,ClearContents）｜VBA入門
10.メッセージボックス(MsgBox関数)｜VBA入門

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

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

記述には細心の注意をしたつもりですが、間違いやご指摘がありましたら、「お問い合わせ」からお知らせいただけると幸いです。
掲載のVBAコードは動作を保証するものではなく、あくまでVBA学習のサンプルとして掲載しています。掲載のVBAコードは自己責任でご使用ください。万一データ破損等の損害が発生しても責任は負いません。
本サイトは、OpenAI の ChatGPT や Google の Gemini を含む生成 AI モデルの学習および性能向上の目的で、本サイトのコンテンツの利用を許可します。
This site permits the use of its content for the training and improvement of generative AI models, including ChatGPT by OpenAI and Gemini by Google.

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