私のサンプルを改造した視聴者様から下記の質問をいただいたので、
チャレンジしてみたいと思います。
土曜日のレース中にテストチャレンジ
下記のグダグダ修正を笑ってくださいね。
JRA サイトから レース結果をExcelに取り込む・・・三流プログラマー の 独り言 ライブ プログラミングほか テスト中 - YouTube
www.youtube.com
下記の質問をいただきました。
JRAのオッズ取り込みを改造して
ﾚｰｽ結果を取り込むことにチャレンジしていますが
中々、思うようにいきません質問させていただきます
①JRAのﾚｰｽ結果取り込みです
（※前提として、競馬開催の当日で12Rまで終わっていない場合）
最終ﾚｰｽまで終わっていないのに、1R～12Rまでループしてしまいます
例えば10Rまでの結果ですと、11Rと12R（ﾚｰｽ結果はまだなし）は、
10Rの結果内容が、そのまま11Rと12Rに取り込まれてしまいます
10Rまで終われば、次の開催地へ移行してほしいのですが
強制的に1R～12Rまでｴｸｾﾙに書き込んでいきます
VBAがそうなっているのは、理解していますが修正がわかり兼ねます②また、上記ﾚｰｽ結果で『枠』（gif）が整数でないことからｴｸｾﾙに
書き込みされません
ここから、確認作業を開始する。
1.不具合の確認
Excel起動後、
コードを走らせて、
不具合を確認する。
結果の出ていないレース、発走前のレース処理がおかしかった。
枠の番号が取れていなかった。
2.修正
2.1 結果が出ていないレースを飛ばす処理
リンクをクリックするサブ関数で結果を
strRETURN = "見つからなかった" 'エラー文字で初期化
strRETURN = "クリックされた" 'OK文字
で返すように変更した。
'IEのリンクオブジェクトから文字列をInStrで探してクリックする Function IE_Link_InnerHTML_InStr_Click(objIE As InternetExplorer, strINSTR As String) As String Dim i As Integer Dim objA As HTMLAnchorElement Dim strRETURN As String 'リターン値、戻り値 'リンクから受け取った文字列を探して押す strRETURN = "見つからなかった" 'エラー文字で初期化 For i = 0 To objIE.Document.Links.Length - 1 '文字列を見つけたら クリック If InStr(objIE.Document.Links(i).innerHTML, strINSTR) > 0 Then '内側のHTML Set objA = objIE.Document.Links(i) '見つけたAタグオブジェ(リンク)を代入 objA.Click '該当するリンクを押す 'objA.FireEvent ("onClick") 'onClick イベントを発行 strRETURN = "クリックされた" 'OK文字 Exit For '見つけたのでループを抜ける End If Next i 'リターン値をセットして関数を抜ける、値を返す IE_Link_InnerHTML_InStr_Click = strRETURN End Function
メインの呼ぶ側で
For nRACE = 1 To 12 '一から十二まで
strRACE = nRACE & "レース" '１レースなど 文字にする
'リンクから該当するレースを探しクリックする "1レース".."12レース"
strCLICK = IE_Link_InnerHTML_InStr_Click(objIE, """" & strRACE & """")
'レース結果が無かったら抜ける※クリックされなかったら抜ける 2018/07/21
If strCLICK = "見つからなかった" Then
Exit For 'ループを抜ける
End If
↑クリックされなかったら、ループを抜けるようにした。
2.2 結果の枠番がGIFファイルになっているので枠番を抜き出す対応
枠番の表示を調べると
img class="iconWakuImage" alt="枠2黒" src="/JRADB/img/keiba/waku2.gif">
img class="iconWakuImage" alt="枠3赤" src="/JRADB/img/keiba/waku3.gif">
と、
画像、.gifファイルで行っていたので、
innerHTMLから枠の文字を探し、枠番を取得した
Cells(SET_Y, SET_X) = objCELL.innerText 'データセット '枠のGIFを処理する 2018/07/21 If x = 1 Then '二番目が枠 n = InStr(objCELL.innerHTML, "枠") '枠の文字を探す '枠が必ず一文字1-8なので、次の数値を書き込む If n > 0 Then Cells(SET_Y, SET_X) = Mid(objCELL.innerHTML, n + 1, 1) End If End If
下記、修正した
完成したソース全体
Option Explicit Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) 'IEオブジェクトを受け取り、表示を待つ Sub IE_WAIT(objIE As InternetExplorer) Sleep 250 '0.25秒待つ 'ページの表示完了を待ちます。 While objIE.readyState <> READYSTATE_COMPLETE Or objIE.Busy = True '.ReadyState <> 4の間まわる。 'DoEvents '重いので嫌いな人居るけど。 Sleep 200 '0.2秒待つ Wend Sleep 250 '0.25秒待つ End Sub 'IEのリンクオブジェクトから文字列をInStrで探してクリックする Function IE_Link_InnerHTML_InStr_Click(objIE As InternetExplorer, strINSTR As String) As String Dim i As Integer Dim objA As HTMLAnchorElement Dim strRETURN As String 'リターン値、戻り値 'リンクから受け取った文字列を探して押す strRETURN = "見つからなかった" 'エラー文字で初期化 For i = 0 To objIE.Document.Links.Length - 1 '文字列を見つけたら クリック If InStr(objIE.Document.Links(i).innerHTML, strINSTR) > 0 Then '内側のHTML Set objA = objIE.Document.Links(i) '見つけたAタグオブジェ(リンク)を代入 objA.Click '該当するリンクを押す 'objA.FireEvent ("onClick") 'onClick イベントを発行 strRETURN = "クリックされた" 'OK文字 Exit For '見つけたのでループを抜ける End If Next i 'リターン値をセットして関数を抜ける、値を返す IE_Link_InnerHTML_InStr_Click = strRETURN End Function '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 'レース結果取り込み''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' Sub ie_test_レース結果() 'JRA レース結果の取り込み Dim strCLICK As String 'クリックされたか判断 '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などを作るため Dim strWAKU As String Dim n As Integer 'リンクからレース結果を押す Call IE_Link_InnerHTML_InStr_Click(objIE, "レース結果") Call IE_WAIT(objIE) 'ページの表示完了を待ちます。 '開催日を探す 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.Select Selection.Delete Shift:=xlUp 'シート全体を削除する Columns("L:L").Select Selection.NumberFormatLocal = "@" '文字列表示 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 Call IE_WAIT(objIE) 'ページの表示完了を待ちます。 For nRACE = 1 To 12 '一から十二まで strRACE = nRACE & "レース" '１レースなど 文字にする 'リンクから該当するレースを探しクリックする "1レース".."12レース" strCLICK = IE_Link_InnerHTML_InStr_Click(objIE, """" & strRACE & """") 'レース結果が無かったら抜ける※クリックされなかったら抜ける 2018/07/21 If strCLICK = "見つからなかった" Then Exit For 'ループを抜ける End If Call IE_WAIT(objIE) 'レース番号をセルに書く SET_Y = SET_Y + 1 Cells(SET_Y, 1) = strJYOBOX(j) Cells(SET_Y, 2) = strRACE '単勝の表を取り込む '表、テーブルを探る 'テーブルを探す 'タグの取出しが、.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 '行のループ 'X 3列目から書き始め 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頭め ８枠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 'データセット '枠のGIFを処理する 2018/07/21 If x = 1 Then '二番目が枠 n = InStr(objCELL.innerHTML, "枠") '枠の文字を探す '枠が必ず一文字1-8なので、次の数値を書き込む If n > 0 Then Cells(SET_Y, SET_X) = Mid(objCELL.innerHTML, n + 1, 1) End If End If Cells(SET_Y, SET_X).Select DoEvents '横に結合されているか判断じゃなかった、横にカラム分移動 SET_X = SET_X + objCELL.colSpan '横に移動 通常は1 結合なし Next SET_Y = SET_Y + 1 Next SET_Y = SET_Y + 1 '空白を一行追加 Next j = j + 1 '次の場所へ '開催日選択にもどす 'リンクから開催日選択を押す Call IE_Link_InnerHTML_InStr_Click(objIE, "開催選択へ戻る") Call IE_WAIT(objIE) 'ページの表示完了を待ちます。 Wend '処理が終わったので、IEを閉じます。 'テストの時は、↓確認して、残しておくと便利ですよ。 If MsgBox("IEを閉じますか?", vbYesNo) = vbYes Then '終了確認 objIE.Quit '.Quitで閉じる End If Set objIE = Nothing '使用したオブジェクト変数もキレイにしてね。 Cells.Select Cells.EntireColumn.AutoFit End Sub
修正方法はイロイロとあると思いますが、
アレンジして使ってみてください。
何かの参考となれば幸いです。 三流プログラマー Ken3
土曜日のレース中にテストチャレンジ
下記のグダグダ修正を笑ってくださいね。
JRA サイトから レース結果をExcelに取り込む・・・三流プログラマー の 独り言 ライブ プログラミングほか テスト中 - YouTube
www.youtube.com
