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

VBAを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で自動取得すれば良い。
※画像は出力例です。見栄えは任意、リンク不要

マクロ VBA 100本ノック


前記の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桁の最小公倍数
参加者様ご紹介


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

VBA10大躓きポイント(初心者が躓きやすいポイント)|VBA技術解説(2024-03-05)
テンキーのスクリーンキーボード作成|ユーザーフォーム入門(2024-02-26)
無効な前方参照か、コンパイルされていない種類への参照です。|エクセル雑感(2024-02-17)
初級脱出10問パック|VBA練習問題(2024-01-24)
累計を求める数式あれこれ|エクセル関数応用(2024-01-22)
複数の文字列を検索して置換するSUBSTITUTE|エクセル入門(2024-01-03)
いくつかの数式の計算中にリソース不足になりました。|エクセル雑感(2023-12-28)
VBAでクリップボードへ文字列を送信・取得する3つの方法|VBA技術解説(2023-12-07)
難しい数式とは何か?|エクセル雑感(2023-12-07)
スピらない スピル数式 スピらせる|エクセル雑感(2023-12-06)


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

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




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


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



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