1Rから12Rまでの書き出しができたので、
次は、
開催場所、開催日のループを作成してみます。
www.youtube.com
JRA 単勝オッズ 開催場所のループ処理 VBA IE操作 Ken3 ライブ プログラミング テスト中 です・・・ - YouTube
1.開催日を取り出す
開催日を取り出します
※日曜日は前日の土曜日があるので、
単純にはいかないけど、今回はすべて取り込む
2.開催日のループを作成
12Rまで取得終了したら、
次の開催地のオッズへ移動
1Rから取得を 開催日がなくなるまで行う
onclick="return doAction('/JRADB/accessO.html','pw15oli00/6D')">
<img src="/JRADB/img/keiba/btn_back-kaisai.gif" alt="開催選択へ戻る"
class="tRBtn"></a> </td>
作成したソースコード
Sub ie_test() 'JRA 単勝オッズの取り込み テスト '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 '一番下のステータスバーを表示。 'JRA TOP ページの表示 '処理したいページを表示します。 objIE.Navigate "http://www.jra.go.jp/" '.Navigate メソッドで JRA表示する。 'ページの表示完了を待ちます。 While objIE.ReadyState <> READYSTATE_COMPLETE Or objIE.Busy = True '.ReadyState <> 4の間まわる。 DoEvents '重いので嫌いな人居るけど。 Wend 'TOPページが表示されたので、表示された文章に対して、処理を行います。 Dim i As Integer '添え字 i番目などで使用 Dim yLINE As Integer '行カウンタ、Y行目 Dim oDocument As HTMLDocument Dim objA As HTMLAnchorElement Dim objTABLEs As Object 'TABLE複数の格納用 Dim objTABLE As HTMLTable 'テーブル単体 Dim x As Integer '列の管理 Dim y As Integer '行の管理 Dim SET_Y As Integer 'Excel側のセット位置 Dim SET_X As Integer 'Excel側のセット位置 Dim objCELL As HTMLTableCell Dim nRACE As Integer 'レース 1-12 Dim strRACE As String '文字列 1Rなどを作るため 'リンクからオッズを押す For i = 0 To objIE.Document.Links.Length - 1 'オッズを見つけたら クリック 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 Next i 'ページの表示完了を待ちます。 While objIE.ReadyState <> READYSTATE_COMPLETE Or objIE.Busy = True '.ReadyState <> 4の間まわる。 DoEvents '重いので嫌いな人居るけど。 Wend '開催日を探す Dim strJYOBOX(10) As String Dim j As Integer '開催日のリンクをあさる j = 0 For i = 0 To objIE.Document.Links.Length - 1 '右端の"日"を条件に判断する If Right(objIE.Document.Links(i).innerText, 1) = "日" Then '内側のTEXT Set objA = objIE.Document.Links(i) '見つけたAタグオブジェ(リンク)を代入 Debug.Print objA.innerText strJYOBOX(j) = objA.innerText strJYOBOX(j + 1) = "END" j = j + 1 End If Next i If j = 0 Then 'エラーのチェック MsgBox "開催日が見つかりません、" Exit Sub End If '出力先をクリアする 'まず、書き込み先シート、データをクリアする Cells.Delete Shift:=xlUp 'シート全体を削除する Range("A1").Select '先頭A1を選択する、 SET_Y = 0 'セット位置を初期化 '場所単位のループ j = 0 While strJYOBOX(j) <> "END" 'ENDになるまで '開催日のリンクをあさる Set objA = Nothing For i = 0 To objIE.Document.Links.Length - 1 '開催場所を条件に判断する If objIE.Document.Links(i).innerText = strJYOBOX(j) Then '内側のTEXT Set objA = objIE.Document.Links(i) '見つけたAタグオブジェ(リンク)を代入 objA.Click '開催日を押す Exit For '見つけたのでループを抜ける End If Next i If objA Is Nothing Then MsgBox strJYOBOX(j) & " リンクが見つかりませんでした" Exit Sub End If 'ページの表示完了を待ちます。 While objIE.ReadyState <> READYSTATE_COMPLETE Or objIE.Busy = True '.ReadyState <> 4の間まわる。 DoEvents '重いので嫌いな人居るけど。 Wend '1R-12R 単勝の表を取り込む '1Rから12Rまで、ループする。※これだと前日発売の時1Rでトラブルなぁ For nRACE = 1 To 12 '一から十二まで strRACE = nRACE & "R" 'R1など 文字にする 'レース番号をセルに書く SET_Y = SET_Y + 1 Cells(SET_Y, 1) = strJYOBOX(j) & " " & strRACE SET_Y = SET_Y + 1 'リンクから該当するレースを探しクリックする For i = 0 To objIE.Document.Links.Length - 1 '"1R"など、レースを見つけたら クリック If InStr(objIE.Document.Links(i).innerHTML, """" & strRACE & """") > 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")で 可能なので、 '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 = 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 '下にも同じくセット 'ホントはループがいいけど、一枠に三頭までなので If objCELL.rowSpan = 3 Then '3頭め ８枠18番など・・ Cells(SET_Y + 2, SET_X) = objCELL.innerText End If 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 '横に移動 通常は1 結合なし Next SET_Y = SET_Y + 1 Next SET_Y = SET_Y + 1 '空白を一行追加 Next j = j + 1 '次の場所へ '開催日選択にもどす 'リンクから開催日選択を押す For i = 0 To objIE.Document.Links.Length - 1 '開催選択へ戻るを見つけたら クリック 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 Next i 'ページの表示完了を待ちます。 While objIE.ReadyState <> READYSTATE_COMPLETE Or objIE.Busy = True '.ReadyState <> 4の間まわる。 DoEvents '重いので嫌いな人居るけど。 Wend Wend '処理が終わったので、IEを閉じます。 'テストの時は、↓確認して、残しておくと便利ですよ。 If MsgBox("IEを閉じますか?", vbYesNo) = vbYes Then '終了確認 objIE.Quit '.Quitで閉じる End If Set objIE = Nothing '使用したオブジェクト変数もキレイにしてね。 End Sub
↑まだまだ、エラー処理とか、関数分割してまとめるとか・・・
イロイロとありますが、たたき台として テストで使ってみてください。
解説動画※冒頭と同じ動画です
JRA 単勝オッズ 開催場所のループ処理 VBA IE操作 Ken3 ライブ プログラミング テスト中 です・・・ - YouTube
www.youtube.com
