WEB HTML形式のテーブル（表）の値を取得する
※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。
※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。
'************************************************** 'HTML形式のテーブル（表）の値を取得する '************************************************** '1.ユーザーフォームを設置 UserForm1 '2.テキストボックスを設置 TextBox1 '3.コマンドボタンを設置 CommandButton1 '4.WebBrowserを設置 WebBrowser1 '************************************************** 'フォーム上のブラウザに指定アドレス先を表示 '************************************************** Private Sub CommandButton1_Click() Me.WebBrowser1.Navigate Trim(Me.TextBox1.Value) End Sub '************************************************** '読み込み（ＤＬ）が完了後発生するイベント '************************************************** '注意：テーブルエレメントは行も列も「0」から始まります。 Private Sub WebBrowser1_DocumentComplete(ByVal pDisp As Object, URL As Variant) Dim sht As Worksheet, cnt As Long Dim cnty As Long, str As String '抽出した値を格納するシートを指定 Set sht = ThisWorkbook.Worksheets("Sheet4") Dim objTable As Object Dim 全テーブル数 As Long Dim 該当テーブル番号 As Long Dim 行数 As Long, x As Long Dim 列数 As Long, y As Long Dim テキスト As String Dim 目的タイトル As String 'ＨＴＭＬドキュメントのテーブルタグをオブジェクトにセット Set objTable = Me.WebBrowser1.Document.getElementsByTagName("TABLE") 'TABLEが無い場合 If objTable Is Nothing Then Set objTable = Nothing MsgBox "TABLE Object Nothing!" Exit Sub End If 'TABLEが無い場合 If objTable.Length = 0 Then Set objTable = Nothing MsgBox "TABLE Object 全テーブル数 = 0!" Exit Sub Else 全テーブル数 = objTable.Length - 1 End If '全テキストのみ抽出（因みに） テキスト = objTable(0).Rows(0).Cells(0).innerText '目的のテーブル番号指定 該当テーブル番号 = 7 str = objTable(該当テーブル番号).Rows(0).Cells(0).innerText 目的タイトル = Trim(Mid(str, 1, InStr(1, str, "[") - 1)) '目的のテーブル番号指定 該当テーブル番号 = 11 '目的のテーブル行数取得 行数 = objTable(該当テーブル番号).Rows.Length - 1 '縦数 'エラー回避 If 行数 < 0 Then MsgBox "TABLE Object ERR!" Exit Sub End If '(項目行必要の場合は0から始める) '(項目行不要の場合は1から始める) For x = 1 To 行数 '目的のテーブル列数取得 列数 = objTable(該当テーブル番号).Rows(x).Cells.Length - 1 'エラー回避 If 列数 < 0 Then MsgBox "TABLE Object ERR!" Exit Sub End If '書き込むシートの最終行取得 cnt = sht.Cells(65536, 1).End(xlUp).Row + 1 'シート書き込み用列番号を初期化 cnty = 0 cnty = cnty + 1 sht.Cells(cnt, cnty).Value = 目的タイトル For y = 0 To 列数 cnty = cnty + 1 テキスト = objTable(該当テーブル番号).Rows(x).Cells(y).innerText Debug.Print "テ[" & 該当テーブル番号 & "]" & "行[" & x & "]" & "列[" & y & "]:" & テキスト sht.Cells(cnt, cnty).Value = Trim(テキスト) Next y Next x Set objTable = Nothing End Sub |