JRAオッズの取り込みで、
枠番の取り込みが正しくなく、
データがズレてセットされてしまった
前回
ken3memo.hatenablog.com
の続きです。
下記、まだ慣れてない ライブ プログラミング動画。
単勝表の取り込み バグ修正 VBA IE操作 JRA Ken3 ライブ プログラミング テスト中 です・・・ - YouTube
www.youtube.com
簡単な解説 と コード
単勝取り込みテスト
現在単勝の表を下記のコードで取り込むと、
'Webの表をシートへ転記(代入する) For y = 0 To objTABLE.Rows.Length - 1 '行のループ For x = 0 To objTABLE.Rows(y).Cells.Length - 1 '列数分ループ ' objTABLE.rows(行).cells(列).innertext Cells(y + 1, x + 1) = objTABLE.Rows(y).Cells(x).innerText Next Next
データがずれてセットされています
原因を探る
・枠番で縦に結合セルみたいな表になっているので、
取り込み処理を工夫しないとズレてしまう。
現物を確認する
<th rowspan="2" class="waku waku7">7</th>
rowspan="2" で 枠が結合された表になっていると
データがズレてセットされてしまう。
デバッグ、
? typename(objTABLE.Rows(0).Cells(0))
HTMLTableCell
Dim objCELL As HTMLTableCell で 型指定を行い、
If objCELL.rowSpan > 1 Then '縦に複数の時
が判断できたので、小細工をしてみた。
小細工して完成したソース
※前半よけいな部分があるけど
Sub ie_test() 'IEの表示をテストする。 'IEの起動 Dim objIE As InternetExplorer '変数を定義します。 Set objIE = CreateObject("InternetExplorer.Application") 'オブジェクトを作成します。 objIE.Visible = True '可視、Trueで見えるようにします。 '表示位置(左上の座標)とサイズ(高さ・幅)を調整する objIE.FullScreen = False '※Trueのモードだとびっくりするよ objIE.Top = 0 '左上 上位置 objIE.Left = 0 '左上 左位置 objIE.Width = 800 '横幅 objIE.Height = 600 '高さ 'XXXバー、外観・外枠の調整。 objIE.Toolbar = True 'タブの切り替えで必要なので、ツールバーを表示にする objIE.MenuBar = False 'メニューは非表示にする objIE.AddressBar = True 'URLなど アドレスバーは確認のため、表示する objIE.StatusBar = True '一番下のステータスバーを表示。 '処理したいページを表示します。 objIE.Navigate "http://www.jra.go.jp/" '.Navigate メソッドで JRA表示する。 'Navigate と Navigate2 の 違いが私もイマイチわかってませんが 'ページの表示完了を待ちます。 While objIE.ReadyState <> READYSTATE_COMPLETE Or objIE.Busy = True '.ReadyState <> 4の間まわる。 DoEvents '重いので嫌いな人居るけど。 Wend 'ページが表示されたので、表示された文章に対して、処理を行います。 'HTML文章objIE.Documentからデータを取得 '入力フォームDocument.Formsでデータをセットしたり送信したり 'リンクDocument.Linksでリンクの情報を取得 Dim i As Integer '添え字 i番目などで使用 Dim yLINE As Integer '行カウンタ、Y行目 Dim oDocument As HTMLDocument Dim objA As HTMLAnchorElement Range("A1") = "調査したURLは " & strURL & " です" 'A1にURLを記述(セット) Range("D1") = "リンクの数は " & objIE.Document.Links.Length & "です" 'D1にリンクの数をセット Range("A2") = ".Href(リンク先)" 'A2~F2 2行目に見出しをセットする Range("B2") = ".OuterText" Range("C2") = ".OuterHTML" Range("D2") = ".InnerText" Range("E2") = ".InnerHTML" Range("F2") = ".Target" Columns("A:F").ColumnWidth = 22 '列幅を22に変更 yLINE = 3 'セット開始の行を代入する For i = 0 To objIE.Document.Links.Length - 1 'データをセルへセットする 'を付けて文字列にする(セルにセットしたいので) Cells(yLINE, "A") = "'" & objIE.Document.Links(i).href 'リンク先 Cells(yLINE, "B") = "'" & objIE.Document.Links(i).outerText '自分を含む テキスト(Innerと変わりない?) Cells(yLINE, "C") = "'" & objIE.Document.Links(i).outerHTML '自分を含む HTML Cells(yLINE, "D") = "'" & objIE.Document.Links(i).innerText '内側のテキスト Cells(yLINE, "E") = "'" & objIE.Document.Links(i).innerHTML '内側のHTML Cells(yLINE, "F") = "'" & objIE.Document.Links(i).target '_Blank や 表示先フレームの名前など 'オッズを見つけたら クリック If InStr(objIE.Document.Links(i).innerHTML, "オッズ") > 0 Then '内側のHTML Set objA = objIE.Document.Links(i) '見つけたAタグオブジェ(リンク)を代入 objA.Click 'オッズを押す 'objA.FireEvent ("onClick") 'onClick イベントを発行 Exit For '見つけたのでループを抜ける End If yLINE = yLINE + 1 'セット位置(行)を+1する Next i '開催日を探す 'ページの表示完了を待ちます。 While objIE.ReadyState <> READYSTATE_COMPLETE Or objIE.Busy = True '.ReadyState <> 4の間まわる。 DoEvents '重いので嫌いな人居るけど。 Wend '開催日のリンクをあさる Range("A1") = "調査したURLは " & strURL & " です" 'A1にURLを記述(セット) Range("D1") = "リンクの数は " & objIE.Document.Links.Length & "です" 'D1にリンクの数をセット Range("A2") = ".Href(リンク先)" 'A2~F2 2行目に見出しをセットする Range("B2") = ".OuterText" Range("C2") = ".OuterHTML" Range("D2") = ".InnerText" Range("E2") = ".InnerHTML" Range("F2") = ".Target" Columns("A:F").ColumnWidth = 22 '列幅を22に変更 yLINE = 3 'セット開始の行を代入する For i = 0 To objIE.Document.Links.Length - 1 'データをセルへセットする 'を付けて文字列にする(セルにセットしたいので) Cells(yLINE, "A") = "'" & objIE.Document.Links(i).href 'リンク先 Cells(yLINE, "B") = "'" & objIE.Document.Links(i).outerText '自分を含む テキスト(Innerと変わりない?) Cells(yLINE, "C") = "'" & objIE.Document.Links(i).outerHTML '自分を含む HTML Cells(yLINE, "D") = "'" & objIE.Document.Links(i).innerText '内側のテキスト Cells(yLINE, "E") = "'" & objIE.Document.Links(i).innerHTML '内側のHTML Cells(yLINE, "F") = "'" & objIE.Document.Links(i).target '_Blank や 表示先フレームの名前など '開催日を見つけたら書き出す If Right(objIE.Document.Links(i).innerText, 1) = "日" Then '内側のTEXT Set objA = objIE.Document.Links(i) '見つけたAタグオブジェ(リンク)を代入 Debug.Print objA.innerText Debug.Print objA.innerHTML objA.Click '開催日を押す Exit For '見つけたのでループを抜ける End If yLINE = yLINE + 1 'セット位置(行)を+1する Next i '試しに1Rを取り込む 'ページの表示完了を待ちます。 While objIE.ReadyState <> READYSTATE_COMPLETE Or objIE.Busy = True '.ReadyState <> 4の間まわる。 DoEvents '重いので嫌いな人居るけど。 Wend For i = 0 To objIE.Document.Links.Length - 1 '1Rを見つけたら クリック If InStr(objIE.Document.Links(i).innerHTML, """1R""") > 0 Then '内側のHTML Set objA = objIE.Document.Links(i) '見つけたAタグオブジェ(リンク)を代入 objA.Click '1Rを押す 'objA.FireEvent ("onClick") 'onClick イベントを発行 Exit For '見つけたのでループを抜ける End If Next i '単勝の表を取り込む 'ページの表示完了を待ちます。 While objIE.ReadyState <> READYSTATE_COMPLETE Or objIE.Busy = True '.ReadyState <> 4の間まわる。 DoEvents '重いので嫌いな人居るけど。 Wend '表、テーブルを探る 'テーブルを探す 'タグの取出しが、.getElementsByTagName("TABLE")で 可能なので、 Dim objTABLEs As Object 'TABLE複数の格納用 Dim objTABLE As HTMLTable 'テーブル単体 '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 'まず、書き込み先シート、データをクリアする Cells.Delete Shift:=xlUp 'シート全体を削除する Range("A2").Select '先頭A1を選択する、 '表をDATAシートに書き出す Dim x As Integer '列の管理 Dim y As Integer '行の管理 Dim SET_Y As Integer Dim SET_X As Integer Dim objCELL As HTMLTableCell SET_Y = 1 'Webの表をシートへ転記(代入する) For y = 0 To objTABLE.Rows.Length - 1 '行のループ SET_X = 1 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 '下にも同じくセット End If '既にデータありか、縦に結合されているか? If Len(Trim("" & Cells(SET_Y, SET_X))) > 0 Then SET_X = SET_X + 1 End If Cells(SET_Y, SET_X) = objCELL.innerText 'データセット '横に結合されているか判断 SET_X = SET_X + objCELL.colSpan 'カラム分 横に移動 Next SET_Y = SET_Y + 1 Next 'イメージDocument.Imagesで画像の情報を取得 'フレームDocument.Framesフレーム分割の文章なら '↑ほかにもイロイロありますが、文章Documentです。 'また、.ExecWBメソッドを使えば 印刷・コピー・貼付 などコマンド・命令を発行できます。(動作が可能です) '処理が終わったので、IEを閉じます。 'テストの時は、↓確認して、残しておくと便利ですよ。 If MsgBox("IEを閉じますか?", vbYesNo) = vbYes Then '終了確認 objIE.Quit '.Quitで閉じる End If Set objIE = Nothing '使用したオブジェクト変数もキレイにしてね。 End Sub
小細工の解説は、動画を見てください ぉぃぉぃ・・・
単勝表の取り込み バグ修正 VBA IE操作 JRA Ken3 ライブ プログラミング テスト中 です・・・ - YouTube
www.youtube.com
※冒頭の動画と一緒です
積み残し 問題点
この処置だと、まだまだで
8枠18番みたいに、ひと枠に3頭 馬が入るとまだまだエラーになるかな
まだまだ、先が長いですね。。。。