下記の質問をいただく
VBA IEでHP等から表をエクセルに抜き出したい場合ですが
以前に競馬の表の取り込み例として'TABLEタグを抜き 複数のテーブルをセット
Set objTABLEs = objIE.document.getElementsByTagName("TABLE")
'↑で代入したオブジェクトからテーブルデータを取り出す。Set objTABLE = Nothing 'オブジェクトを空にする
For i = 0 To objTABLEs.Length - 1 'テーブル数分回す
If objTABLEs(i).Rows(0).Cells(0).innerText = "〇〇" Then
'左上が人気を見つける
Set objTABLE = objTABLEs(i) 'i盤目を代入
Exit For
End If
Next i'↑で見つかったかチェックする
If objTABLE Is Nothing Then
MsgBox "〇〇が見つかりません"
Exit Sub 'エラー表示して抜ける
End If
'表をDATAシートに書き出す
'Webの表をシートへ転記(代入する)
For y = 0 To objTABLE.Rows.Length - 1 '行のループ
SET_X = 3
For x = 0 To objTABLE.Rows(y).Cells.Length - 1 '列数分ループ
' objTABLE.rows(行).cells(列)
Set objCELL = objTABLE.Rows(y).Cells(x)'結合セル、枠などに対応
If objCELL.rowSpan > 1 Then '縦に複数の時
Cells(SET_Y + 1, SET_X) = objCELL.innerText '下にも同じくセット
'ホントはループがいいけど、一枠に三頭までなので
If objCELL.rowSpan = 3 Then '3頭め 8枠18番など・・
Cells(SET_Y + 2, SET_X) = objCELL.outerHTML
End If
End If'既にデータありか、縦に結合されているか?
If Len(Trim("" & Cells(SET_Y, SET_X))) > 0 Then
SET_X = SET_X + 1 '縦結合を飛ばすために横に移動
End IfCells(SET_Y, SET_X) = objCELL.outerHTML 'データセット
'横に結合されているか判断じゃなかった、横にカラム分移動
SET_X = SET_X + objCELL.colSpan '横に移動 通常は1 結合なし
Cells(SET_Y, 1) = strJYOBOX(j)
Cells(SET_Y, 2) = strRACE
Next
SET_Y = SET_Y + 1Next
SET_Y = SET_Y + 1 '空白を一行追加
Nextっと参考にさせて頂いておりましたが
これは、常に表の左端、最上段で〇〇というキーワードで
表の全て内容(列)を抜き出しエクセルに抽出していましたが今回、小生が取り込みたいのは
固定の表でなく抜き出したい項目の列が変動します
それに対応できる抽出で
抜き出したい表が、青色列(固定)A列 B列(ゼッケン、名前)の次に必ず
黄色列(その時により列が変動)前回1~前回5を
続けて抜き出したいです
B列と前回1の間が一定でなく変動した場合でも対応ができますでしょか?HPの表のパターンとして例で3つ挙げました
欲しいデータは、青色列 A列 B列(ゼッケン、名前)と黄色列の前回1~前回5だけです
※添付のエクセルをご確認ください Sheet1です
可能でしょうか?また、上記内容が不可能な場合
列が変動する 黄色列の前回1~前回5でけでも抜き出し可能でしょうか?
※添付のエクセルをご確認ください Sheet2です
JRA競馬のオッズ取得だと、
表の左上 .Rows(0).Cells(0).innerText = "〇〇"で判断しているが、
形の違う表から(テストで現在3パターン)
ゼッケン,名前,前回1,前回2,前回3,前回4,前回5
の列を探して取得したい、指定した列を取得したい。
そんな感じかな。
SQL文なら
Select ゼッケン,名前,前回1,前回2,前回3,前回4,前回5
From Web上の表1
Select ゼッケン,名前,前回1,前回2,前回3,前回4,前回5
From Web上の表2
Select ゼッケン,名前,前回1,前回2,前回3,前回4,前回5
From Web上の表3
ってパターンなんだろうけど
さてと、どうするかなぁ・・・・・
下記、いつものヘンテコ解説動画です。
Excel VBA IE操作 web上の表 Tableから指定された項目・列を取得したい エクセルからIEを操作して情報を抜き取るテスト - YouTube
www.youtube.com
マクロの入ったxlsmファイルを
test/IE20190109.zip
に保存しました。合わせてみてください。
結果の列とWeb表の列をマッチングさせ、シートにデータを転記するようにします。
1.Excel側、結果の列を用意する
結果の列を用意します。
'2019/01/09 目的の列を管理する変数ほか Dim n列位置 As Integer Const 抜き出す列 = "ゼッケン,名前,前回1,前回2,前回3,前回4,前回5" Dim str列BOX '↑からSplitでカンマで分割して、目的の列を配列にする str列BOX = Split(抜き出す列, ",") '配列データを作成
↑まぁ、
Const 抜き出す列 = "ゼッケン,名前,前回1,前回2,前回3,前回4,前回5"
みたいな感じで、設定します。
カンマ区切りを用意したので、Splitで分解、
2.見出しを書き込む
'ループで列名データを表示させる For x = 0 To UBound(str列BOX) 'UBound使用インデックス最大値までループ Cells(SET_Y, SET_X + x) = str列BOX(x) Next x SET_Y = SET_Y + 1 '一行セット位置を下に
3.Webページから表を見つける
前回までだと、左上だけ探してましたが、
今回は列があるか?ループで探してみます。
'TABLEタグを抜き 複数のテーブルをセット Set objTABLEs = objIE.Document.getElementsByTagName("TABLE") '↑で代入したオブジェクトからテーブルデータを取り出す。 Set objTABLE = Nothing 'オブジェクトを空にする For i = 0 To objTABLEs.Length - 1 'テーブル数分回す 'web上の表、一行目に目的の列が存在するかチェックする For x = 0 To objTABLEs(i).Rows(0).Cells.Length - 1 'web上の表、列数分ループ ' objTABLE.rows(行).cells(列) Set objCELL = objTABLEs(i).Rows(0).Cells(x) For n列位置 = 0 To UBound(str列BOX) '指定された列名があるかループでチェック? If objCELL.innerText = str列BOX(n列位置) Then '列が一つでも見つかったら Set objTABLE = objTABLEs(i) 'i番目のテーブルを代入 Exit For End If Next n列位置 If Not (objTABLE Is Nothing) Then Exit For 'テーブルが見つかっていたら抜ける Next x If Not (objTABLE Is Nothing) Then Exit For 'テーブルが見つかっていたら抜ける Next i
4.表をみつけたら、シートに書き込みます。
今回は、単純にシートに書き込めないので、
1つ1つ列を比較しながら、せっとしていきます。
'Webの表をシートへ転記(代入する) For y = 1 To objTABLE.Rows.Length - 1 '行のループ ※y=1で二行目からループ For x = 0 To objTABLE.Rows(y).Cells.Length - 1 '列数分ループ ' objTABLE.rows(行).cells(列) Set objCELL = objTABLE.Rows(y).Cells(x) 'これがwebの列 'セットする位置を探して、データをセットする 'web上の列名と目的の列名を比べ、同じならデータをセットする For n列位置 = 0 To UBound(str列BOX) '指定された列名があるかループでチェック? If objTABLE.Rows(0).Cells(x).innerText = str列BOX(n列位置) Then '列が見つかったら Cells(SET_Y, SET_X + n列位置) = objCELL.innerText 'データセット Exit For End If Next n列位置 Next SET_Y = SET_Y + 1 Next SET_Y = SET_Y + 1 '空白を一行追加
少し、トリッキーですが、こんな感じかな?
テスト
6. セットする列を変えてみる
7.基準のSET_YとSET_Xを変えてテストしてみる
8.連続ページのテスト サンプル1~3を連続でテストしてみる
テスト用html
http://ie.vba-ken3.jp/test/20190109test/sample1.html
http://ie.vba-ken3.jp/test/20190109test/sample2.html
http://ie.vba-ken3.jp/test/20190109test/sample3.html
マクロの入ったxlsmファイルを
http://ie.vba-ken3.jp/test/IE20190109.zip
に保存しました。合わせてみてください。