読者です 読者をやめる 読者になる 読者になる

三流君のソースコード置き場

三流プログラマーが作成したコードが置いてあります。あまり参考にならないと思いますがヨロシクお願いします。

複数テーブルを取得 .getElementsByTagName

簡単な解説は、
http://ken3memo.hatenablog.com/entry/2016/12/06/225432
に置いておきました。
少しでも、一つでも処理の参考となれば・・・・

Option Explicit

Sub le_test20161206_複数テーブルを取得()

    'IE起動
    Dim objIE    As Object  'IEオブジェクト参照用
    Set objIE = CreateObject("InternetExplorer.application") 'IEのオブジェクトを作る
    objIE.Visible = True '見えるようにする(お約束)
    
    '.Navigate で 指定した文字列のURLを開く
    objIE.Navigate "http://ie.vba-ken3.jp/test/20161101j1j2.html"

    '表示終了まで待つ .Busy(忙しい)間 と.ReadyState(ステータス)が4以外の時 ループ
    Do While objIE.Busy = True
         DoEvents  '特に何もしないで.Busyの状態が変わるまで待つ
    Loop
    Do While objIE.ReadyState <> 4
         DoEvents  '特に何もしないで.ReadyStateの状態が4に変わるまで待つ
    Loop
    
    'テーブルを探す
    'タグの取出しが、.getElementsByTagName("TABLE")で 可能なので、
    Dim objTABLEs As Object 'TABLEを複数 格納用
    
    'TABLEタグを複数取り出す
    Set objTABLEs = objIE.document.getElementsByTagName("table")

    'まず、書き込み先シートに切り替え、データをクリアする
    Sheets("DATA").Select    'シートを切り替える
    Cells.Delete Shift:=xlUp 'シート全体を削除する
    Range("A1").Select       '先頭A1を選択する、
    
    '表をDATAシートに書き出す
    Dim j As Integer  '列の管理
    Dim i As Integer  '行の管理
    Dim n As Integer  'TABLEの管理
    Dim yy As Integer 'セットする行
    Dim aa As String  '一時保管用
    
  
  'Webの表をシートへ転記(代入する)
  yy = 1  'セットする位置を初期化
  
  For n = 0 To objTABLEs.Length - 1  'TABLEの数ループ
    
    For i = 0 To objTABLEs(n).Rows.Length - 1 '行の数 ループ
    
       For j = 0 To objTABLEs(n).Rows(i).Cells.Length - 1  '列のループ
            'objTABLEs(テーブル).Rows(行).Cells(列).テキスト値
            aa = objTABLEs(n).Rows(i).Cells(j).innerText
            Sheets("DATA").Cells(yy, j + 1) = aa
       Next j
       
       yy = yy + 1   'セット位置 行を増やす
    
    Next i
    
  Next n
  
    '終了処理
    objIE.Quit  'IEを閉じる
    Set objIE = Nothing   '変数の後始末
    
End Sub

おまけ・蛇足 TRで集めて処理してみた

Sub le_test20161206_TRタグを集めてみた()

    'IE起動
    Dim objIE    As Object  'IEオブジェクト参照用
    Set objIE = CreateObject("InternetExplorer.application") 'IEのオブジェクトを作る
    objIE.Visible = True '見えるようにする(お約束)
    
    '.Navigate で 指定した文字列のURLを開く
    objIE.Navigate "http://ie.vba-ken3.jp/test/20161101j1j2.html"

    '表示終了まで待つ .Busy(忙しい)間 と.ReadyState(ステータス)が4以外の時 ループ
    Do While objIE.Busy = True
         DoEvents  '特に何もしないで.Busyの状態が変わるまで待つ
    Loop
    Do While objIE.ReadyState <> 4
         DoEvents  '特に何もしないで.ReadyStateの状態が4に変わるまで待つ
    Loop
    
    'TR 行を探す
    'タグの取出しが、.getElementsByTagName("TR")で 可能なので、
    Dim objTR As Object 'TR タグを複数 格納用
    
    'TRタグを複数取り出す
    Set objTR = objIE.document.getElementsByTagName("TR")

    'まず、書き込み先シートに切り替え、データをクリアする
    Sheets("DATA").Select    'シートを切り替える
    Cells.Delete Shift:=xlUp 'シート全体を削除する
    Range("A1").Select       '先頭A1を選択する、
    
    '表をDATAシートに書き出す
    Dim j As Integer  '列の管理
    Dim i As Integer  '行の管理
    Dim yy As Integer 'セットする行
    Dim aa As String  '一時保管用
    
  
  'Webの表をシートへ転記(代入する)
  yy = 1  'セットする位置を初期化
  
    For i = 0 To objTR.Length - 1 '行の数 ループ
    
       For j = 0 To objTR(i).Cells.Length - 1  '列のループ
            'objTR(行).Cells(列).テキスト値
            aa = objTR(i).Cells(j).innerText
            Sheets("DATA").Cells(yy, j + 1) = aa
       Next j
       
       yy = yy + 1   'セット位置 行を増やす
    
    Next i
    
    '終了処理
    objIE.Quit  'IEを閉じる
    Set objIE = Nothing   '変数の後始末
    
End Sub


www.youtube.com
https://www.youtube.com/watch?v=TqHB16Mj8tI
↑失敗操作、デバッグ風景を笑ってくださいね。ぉぃぉぃ。