VBA100本ノック 100本目:WEBから100本ノックのリストを取得
WEBページから100本ノックのリストを取得する問題です。
ツイートでの見やすさを考慮して、ブック・シート指定等を適宜省略しています。
出題
以下のページにはVBA100本ノックのリストが掲載してあります。
https://excel-ubara.com/vba100sample/vba100list.html
この一覧を表形式でシートに出力してください。
方法不問。VBAで自動取得すれば良い。
※画像は出力例です。見栄えは任意、リンク不要

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を掲載しました。
補足
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コードです。
そこから不要な部分を削除して整理しました。
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
指定のタグが無い場合等のエラー処理は入れていません。
必要に応じて、適宜エラー処理は追加してください。
サイト内関連ページ
同じテーマ「VBA100本ノック」の記事
95本目:図形のテキストを検索するフォーム作成
96本目:Accessデータを取得(マスタ結合&抽出)
97本目:Accessデータを取得(グループ集計)
98本目:席替えルールが守られているか確認
99本目:自動席替え(行列と前後左右が全て違うように)
100本目:WEBから100本ノックのリストを取得
魔球編:組み合わせ問題
魔球編:閉領域の塗り潰し
迷宮編:巡回セル問題
魔球編:2桁の最小公倍数
参加者様ご紹介
新着記事NEW ・・・新着記事一覧を見る
WshNetwork(ネットワークドライブの割り当て等)|VBA技術解説(2025-04-09)
TRANSLATE関数(翻訳) DETECTLANGUAGE関数(言語識別)|エクセル入門(2025-04-08)
QRコード、バーコード作成の覚え書き|エクセル関数応用(2025-04-05)
TRIMRANGE関数(セル範囲をトリム:端の空白セルを除外)|エクセル入門(2024-08-30)
正規表現関数(REGEXTEST,REGEXREPLACE,REGEXEXTRACT)|エクセル入門(2024-07-02)
エクセルが起動しない、Excelが立ち上がらない|エクセル雑感(2024-04-11)
ブール型(Boolean)のis変数・フラグについて|VBA技術解説(2024-04-05)
テキストの内容によって図形を削除する|VBA技術解説(2024-04-02)
ExcelマクロVBA入門目次|エクセルの神髄(2024-03-20)
VBA10大躓きポイント(初心者が躓きやすいポイント)|VBA技術解説(2024-03-05)
アクセスランキング ・・・ ランキング一覧を見る
1.最終行の取得(End,Rows.Count)|VBA入門
2.セルのコピー&値の貼り付け(PasteSpecial)|VBA入門
3.繰り返し処理(For Next)|VBA入門
4.変数宣言のDimとデータ型|VBA入門
5.RangeとCellsの使い方|VBA入門
6.ひらがな⇔カタカナの変換|エクセル基本操作
7.セルのクリア(Clear,ClearContents)|VBA入門
8.メッセージボックス(MsgBox関数)|VBA入門
9.ブックを閉じる・保存(Close,Save,SaveAs)|VBA入門
10.条件分岐(Select Case)|VBA入門
- ホーム
- マクロVBA入門編
- VBA100本ノック
- 100本目:WEBから100本ノックのリストを取得
このサイトがお役に立ちましたら「シェア」「Bookmark」をお願いいたします。
記述には細心の注意をしたつもりですが、
間違いやご指摘がありましたら、「お問い合わせ」からお知らせいただけると幸いです。
掲載のVBAコードは動作を保証するものではなく、あくまでVBA学習のサンプルとして掲載しています。
掲載のVBAコードは自己責任でご使用ください。万一データ破損等の損害が発生しても責任は負いません。