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 ・・・新着記事一覧を見る
シートコピー後のアクティブシートは何か|ツイッター出題回答 (2023-09-19)
Excel関数の引数を省略した場合について|ツイッター出題回答 (2023-09-14)
セル個数を返すRange.CountLargeプロパティとは|VBA技術解説(2023-09-08)
記号を繰り返してグラフ作成(10単位で折り返す)|ツイッター出題回答 (2023-08-28)
シートを削除:不定数のシート名に対応|VBAサンプル集(2023-08-24)
ランクによりボイントを付ける(同順位はポイントを分割)|ツイッター出題回答 (2023-08-22)
OneDrive使用時のThisWorkbook.Pathの扱い方|VBA技術解説(2023-07-26)
列幅不足による###表示や指数表示を判定する|VBA技術解説(2023-07-12)
シートを削除:不定数のシート名に対応|VBAサンプル集(2023-07-04)
シート関数のCOUNTIFS,SUMIFS,MAXIFSと同じ処理|Power Query(M言語)入門(2023-02-28)
アクセスランキング ・・・ ランキング一覧を見る
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コードは自己責任でご使用ください。万一データ破損等の損害が発生しても責任は負いません。