全ての取り出しが バグりながらできてきたので、
次は、
開催日 と レース
指定にチャレンジしてみたいと思います。
下記、いつもの解説動画です。ソースと合わせてみてください
JRA オッズ取得 開催地とレースを指定 VBA IE操作 Ken3 ライブ プログラミング テスト中 - YouTube
www.youtube.com
もらった要望
ア.一つだけご教示お願いしたいことがあります。
'開催日を探す 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
上記構文で、開催日、開催場所を変数へ格納していると思われますが、実は開催日、開催場所については予め先にDLして、「開催地」というシート
の中のセルに「2回福島7日」というように、すでに記載してあります。
それはDLしたデータから分析用のソフトやグラフを作ると、重くなるので、1つの開催場で1つのBOOKにしてあるためです。
そこでBOOKの別シートの「2回福島7日」を指定して取り込む方法をご教示お願いできませんでしょうか。
MENUシートのB2に開催場所を入力しておき、
'開催場所 B2と一致を条件に判断する
If objIE.Document.Links(i).innerText = Sheets("MENU").Range("B2") Then '内側のTEXT
で比べてみました。
Sub ie_単勝オッズ_シートから場所指定() '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表示する。 Call IE_WAIT(objIE) 'ページの表示完了を待ちます。 '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などを作るため 'リンクからオッズを押す Call IE_Link_InnerHTML_InStr_Click(objIE, "オッズ") Call IE_WAIT(objIE) 'ページの表示完了を待ちます。 '開催日のリンクをあさる Set objA = Nothing For i = 0 To objIE.Document.Links.Length - 1 '開催場所 B2と一致を条件に判断する If objIE.Document.Links(i).innerText = Sheets("MENU").Range("B2") Then '内側のTEXT Set objA = objIE.Document.Links(i) '見つけたAタグオブジェ(リンク)を代入 objA.Click '開催日を押す Exit For '見つけたのでループを抜ける End If Next i If objA Is Nothing Then MsgBox Sheets("MENU").Range("B2") & " リンクが見つかりませんでした" Exit Sub End If Call IE_WAIT(objIE) 'ページの表示完了を待ちます。 '出力先をクリアする 'まず、書き込み先シート、データをクリアする Sheets("単勝馬番順").Select 'シートの切り替え Cells.Delete Shift:=xlUp 'シート全体を削除する Range("A1").Select '先頭A1を選択する、 '1R-12R 単勝の表を取り込む SET_Y = 0 'セット位置を初期化 '1Rから12Rまで、ループする。※これだと前日発売の時1Rでトラブルなぁ For nRACE = 1 To 12 '一から十二まで strRACE = nRACE & "R" 'R1など 文字にする 'レース番号をセルに書く SET_Y = SET_Y + 1 Cells(SET_Y, 1) = Sheets("MENU").Range("B2") & " " & strRACE SET_Y = SET_Y + 1 'リンクから該当するレースを探しクリックする "1R".."12R" Call IE_Link_InnerHTML_InStr_Click(objIE, """" & strRACE & """") Call IE_WAIT(objIE) 'ページの表示完了を待ちます。 '単勝の表を取り込む '表、テーブルを探る 'テーブルを探す 'タグの取出しが、.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頭め 8枠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 '処理が終わったので、IEを閉じます。 'テストの時は、↓確認して、残しておくと便利ですよ。 If MsgBox("IEを閉じますか?", vbYesNo) = vbYes Then '終了確認 objIE.Quit '.Quitで閉じる End If Set objIE = Nothing '使用したオブジェクト変数もキレイにしてね。 End Sub
イ.1~12Rまで連続で取り込む構文と、レースを1つのみ指定する場合もご教示お願いできませんか。
変数に格納されているデータの一部を変えるのは、ちょっと難しいのでお願いします。
↑MENUシートにフラグを立て、
'B5からのフラグが立っていたらレースを取り込む
If Sheets("MENU").Range("B4").Offset(nRACE, 0) = 1 Then
・
・
・
End If
で、判断して、処理を行ってみました。
Sub ie_単勝オッズ_シートから場所とレース指定() '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表示する。 Call IE_WAIT(objIE) 'ページの表示完了を待ちます。 '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などを作るため 'リンクからオッズを押す Call IE_Link_InnerHTML_InStr_Click(objIE, "オッズ") Call IE_WAIT(objIE) 'ページの表示完了を待ちます。 '開催日のリンクをあさる Set objA = Nothing For i = 0 To objIE.Document.Links.Length - 1 '開催場所 B2と一致を条件に判断する If objIE.Document.Links(i).innerText = Sheets("MENU").Range("B2") Then '内側のTEXT Set objA = objIE.Document.Links(i) '見つけたAタグオブジェ(リンク)を代入 objA.Click '開催日を押す Exit For '見つけたのでループを抜ける End If Next i If objA Is Nothing Then MsgBox Sheets("MENU").Range("B2") & " リンクが見つかりませんでした" Exit Sub End If Call IE_WAIT(objIE) 'ページの表示完了を待ちます。 '出力先をクリアする 'まず、書き込み先シート、データをクリアする Sheets("単勝馬番順").Select 'シートの切り替え Cells.Delete Shift:=xlUp 'シート全体を削除する Range("A1").Select '先頭A1を選択する、 '1R-12R 単勝の表を取り込む SET_Y = 0 'セット位置を初期化 '1Rから12Rまで、ループする。※これだと前日発売の時1Rでトラブルなぁ For nRACE = 1 To 12 '一から十二まで 'B5からのフラグが立っていたらレースを取り込む If Sheets("MENU").Range("B4").Offset(nRACE, 0) = 1 Then strRACE = nRACE & "R" 'R1など 文字にする 'レース番号をセルに書く SET_Y = SET_Y + 1 Cells(SET_Y, 1) = Sheets("MENU").Range("B2") & " " & strRACE SET_Y = SET_Y + 1 'リンクから該当するレースを探しクリックする "1R".."12R" Call IE_Link_InnerHTML_InStr_Click(objIE, """" & strRACE & """") Call IE_WAIT(objIE) 'ページの表示完了を待ちます。 '単勝の表を取り込む '表、テーブルを探る 'テーブルを探す 'タグの取出しが、.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頭め 8枠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 '空白を一行追加 End If 'フラグが立っていたら↑ Next '処理が終わったので、IEを閉じます。 'テストの時は、↓確認して、残しておくと便利ですよ。 If MsgBox("IEを閉じますか?", vbYesNo) = vbYes Then '終了確認 objIE.Quit '.Quitで閉じる End If Set objIE = Nothing '使用したオブジェクト変数もキレイにしてね。 End Sub
ウ.レースをシート別に取得できませんか?ヨロシクお願いします
↑シートを1Rから12Rまで用意して、
単純に
Sheets(nRACE & "R").Select 'シートの切り替え
と、.Selectで切り替えて処理してみました。
Sub ie_単勝オッズ_シートから場所とレース指定_シート別() '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表示する。 Call IE_WAIT(objIE) 'ページの表示完了を待ちます。 '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などを作るため 'リンクからオッズを押す Call IE_Link_InnerHTML_InStr_Click(objIE, "オッズ") Call IE_WAIT(objIE) 'ページの表示完了を待ちます。 '開催日のリンクをあさる Set objA = Nothing For i = 0 To objIE.Document.Links.Length - 1 '開催場所 B2と一致を条件に判断する If objIE.Document.Links(i).innerText = Sheets("MENU").Range("B2") Then '内側のTEXT Set objA = objIE.Document.Links(i) '見つけたAタグオブジェ(リンク)を代入 objA.Click '開催日を押す Exit For '見つけたのでループを抜ける End If Next i If objA Is Nothing Then MsgBox Sheets("MENU").Range("B2") & " リンクが見つかりませんでした" Exit Sub End If Call IE_WAIT(objIE) 'ページの表示完了を待ちます。 '1R-12R 単勝の表を取り込む '1Rから12Rまで、ループする。※これだと前日発売の時1Rでトラブルなぁ For nRACE = 1 To 12 '一から十二まで 'B5からのフラグが立っていたらレースを取り込む If Sheets("MENU").Range("B4").Offset(nRACE, 0) = 1 Then '出力先をクリアする 'まず、書き込み先シート、データをクリアする Sheets(nRACE & "R").Select 'シートの切り替え Cells.Delete Shift:=xlUp 'シート全体を削除する Range("A1").Select '先頭A1を選択する、 SET_Y = 0 'セット位置を初期化 strRACE = nRACE & "R" 'R1など 文字にする 'レース番号をセルに書く SET_Y = SET_Y + 1 Cells(SET_Y, 1) = Sheets("MENU").Range("B2") & " " & strRACE SET_Y = SET_Y + 1 'リンクから該当するレースを探しクリックする "1R".."12R" Call IE_Link_InnerHTML_InStr_Click(objIE, """" & strRACE & """") Call IE_WAIT(objIE) 'ページの表示完了を待ちます。 '単勝の表を取り込む '表、テーブルを探る 'テーブルを探す 'タグの取出しが、.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頭め 8枠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 '空白を一行追加 End If 'フラグが立っていたら↑ Next '処理が終わったので、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