ワイドと三連複のオッズを取得したい
と質問があったので、
今回は、三連複のオッズ取得に挑戦してみます。
下記、デバッグ動画です、うまくコードをアレンジしてみてください。
youtu.be
https://youtu.be/MEOvxlcubAw
目次
00:00 挨拶と実行テスト
02:36 オッズのテーブルを判断してExcelに三連複オッズを取得
05:30 三連複の表を探す
08:45 1‐2,1‐3 などを tableのcaptionで判断
11:15 三連複のオッズをExcelのセルに書き出す
13:52 表の探し方ついて
16:40 場所を中京に テスト実行と解説
#オッズ取得 #ExcelVBA #三連複 #マクロ #競馬 #JRA #VBA #デバッグ #テスト
1.開催日・場所は、流用する
単勝オッズの取得から、
開催日と場所の選択は単勝オッズ取得
ken3memo.hatenablog.com
https://www.youtube.com/watch?v=RjZZUq40gxY
から流用しました。
2.三連複のオッズを押す
ここも、前回から流用(探す条件:ワイドを3連複に変えただけ)
'リンクから、レースのTR行を探し、列 ここでは3連複などを返す 20221001追加修正
strLINK = IE_Link_InnerHTML_InStr_TR_TD(oDocument, strRACE, "3連複")
みたいに、レースと3連複(前回はワイドでした)で指定したリンクを取り出す。
何言ってんだか・・・
オッズのリンクが
1R 単勝複勝 枠連 馬連 ワイド 馬単 3連複 3連単
2R 単勝複勝 枠連 馬連 ワイド 馬単 3連複 3連単
・
・
・
11R 単勝複勝 枠連 馬連 ワイド 馬単 3連複 3連単
12R 単勝複勝 枠連 馬連 ワイド 馬単 3連複 3連単
と、並んでいるので、
※前回のワイド を 3連複に直しただけです。
解説は、前回の
ken3memo.hatenablog.com
https://www.youtube.com/watch?v=XnIN8XRi-yA
↑を見てください(見て、変な処理を笑ってください・・・)
3.オッズのテーブルを判断して、Excelに三連複オッズを取得
3.1 tableのcaptionで判断?さて、どうしよう・・・
頭の1-2-3のオッズは、下記のようなテーブルになってます。
<h4 class="sub_header lg"> <span class="inner"><span class="num">1</span><span class="name">アルトシュタット</span></span> <span class="btn_page_top"><a href="#" class="btn-def btn-xs btn-narrow anchor_top"><i class="fa fa-chevron-circle-up" aria-hidden="true"></i>ページトップへ戻る</a></span> </h4> <ul class="fuku3_list mt15"> <li> <table class="basic narrow-xy fuku3"> <caption>1-2</caption> <tbody> <tr> <th scope="row">3</th><td><strong class="red">62.7</strong></td></tr> <tr>
と、
JRAさんのページはしっかり作られていて、勉強になりますね。
さてさて、アプローチ、攻める糸口は・・・
1-2 3,4,5,,,18
1-3 4,5,6,,18
・
・
2-3 4,5,6,,,18
2-4 5,6,,,18
・
・
3-4 5,6,,,18
なので
馬番1のループは 最大 1~16(16-17-18が最後なので)
1
2
3
・
・
馬番1-馬番2 の ループは、馬番2の最初は馬番1の次(あたりまえだろ)
1-2
2-3
3-4
・
・
↑のループになる
なので、
何も考えないで、力業のループを組んでみた。
※テーブルを探すのに、無駄なループが増えるけど・・・
'テーブルを探す 'タグの取出しが、.getElementsByTagName("TABLE")で 可能なので、 For n馬番1 = 1 To 16 '馬番は最大18頭、16-17-18が最後なのでMAX16までループ For n馬番2 = n馬番1 + 1 To 17 '1-2-3 から 1-17-18, 2-3-4,,2-17-18 MAX最終は16-17-18 'TABLEタグを抜き 複数のテーブルをセット Set objTABLEs = oDocument.getElementsByTagName("TABLE") '↑で代入したオブジェクトからテーブルデータを取り出す。 '探す 1-2,1-3,,,16-17を作成する str探す文字列 = n馬番1 & "-" & n馬番2 Set objTABLE = Nothing 'オブジェクトを空にする For i = 0 To objTABLEs.Length - 1 'テーブル数分回す 'テーブルのcaptionが処理する1-2や1-3かチェック If objTABLEs(i).Caption.innerText = str探す文字列 Then '一致したテーブルGet Set objTABLE = objTABLEs(i) 'みつけたらi番目を代入 Exit For End If Next i '↑で見つかったかチェックする If objTABLE Is Nothing Then '見つからなかったら、終わっていたら、ループを抜ける Exit For '抜ける End If
3.2 あとは、いつもの objTABLE.Rows.Length で縦の行を移動させて書き込む
'表をDATAシートに書き出す 'テーブルからデータを抜き出す、書き出す For y = 0 To objTABLE.Rows.Length - 1 '行のループ 'データをセルに書く 馬番 馬番 馬番 三連複オッズ Cells(SET_Y, 1) = n馬番1 '馬番キャプション Cells(SET_Y, 2) = n馬番2 ' Cells(SET_Y, 3) = objTABLE.Rows(y).Cells(0).innerText '馬番 ここを馬番3にする Cells(SET_Y, 4) = objTABLE.Rows(y).Cells(1).innerText '三連複オッズ SET_Y = SET_Y + 1 Next y Next n馬番2 Cells(SET_Y, 1).Select '.Selecで位置を移動させると DoEvents '描画すると、遅くなるけど↑固まっているように見えるので
アレンジして、コードを使ってみてください。
もっと、使いやすいコード、
わかりやすい説明をしないとなぁ・・と思いつつ、失礼します。
2022/10/01 今回修正追加した、ソースコード
Option Explicit '20221001 テスト Sub JRA三連複オッズをレース別に複数蓄積する() 'ワイドの取得テスト ActiveWindow.WindowState = xlMinimized '最小表示 DoEvents Sleep 1000 '1秒待つ ActiveWindow.WindowState = xlNormal 'ノーマル表示 DoEvents 'JRA TOP ページの表示 '処理したいページをGET Dim strURL As String Dim strHTML As String strURL = "https://www.jra.go.jp/" strHTML = get_htmlfile(strURL) 'JRA TOPをGetする 'TOPページ文章に対して、処理を行います。 Dim i As Integer '添え字 i番目などで使用 Dim yLINE As Integer '行カウンタ、Y行目 Dim oDocument As Object Set oDocument = CreateObject("htmlfile") 'Set oDocument = New HTMLDocument '参照設定したとき 'oDocument.write "<html><body>test</body></html>" 'HTMLをセット 'Stop strHTML = Replace(strHTML, "script", "") 'scriptを止めるTEST oDocument.write strHTML '取得したHTMLをセット DoEvents Sleep 1000 '1秒待つ 'htmlfile_WAIT_TEST (oDocument) 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 Waku_str As String Dim Waku_n As Integer 'リンクからオッズを押す Dim strLINK As String strLINK = IE_Link_InnerHTML_InStr_Click(oDocument, "オッズ") If strLINK = "ERR" Then MsgBox "オッズが見つかりません" Stop End If 'オッズのページ HTMLを取り出す '<A onclick="doAction('/JRADB/accessO.html','pw15oli00/6D');return '文字列切り出し(strMOJI, "doAction('","','") '文字列切り出し(strMOJI, "','","')") Dim strPARA As String strURL = "https://www.jra.go.jp" & 文字列切り出し(strLINK, "doAction('", "','") 'URL strPARA = "cname=" & 文字列切り出し(strLINK, "','", "')") 'パラメーター strHTML = get_htmlfile_post(strURL, strPARA) 'パラメーターを付けて開く Set oDocument = Nothing Set oDocument = CreateObject("htmlfile") oDocument.write strHTML '取得したHTMLをセット DoEvents Sleep 1000 '1秒待つ DoEvents '開催日のリンクをあさる strLINK = IE_Link_InnerHTML_InStr_Click(oDocument, Sheets("MENU").Range("B2")) If strLINK = "ERR" Then MsgBox Sheets("MENU").Range("B2") & "が見つかりません" Stop End If strURL = "https://www.jra.go.jp" & 文字列切り出し(strLINK, "doAction('", "',") 'URL strPARA = "cname=" & 文字列切り出し(strLINK, "', '", "')") 'パラメーター strHTML = get_htmlfile_post(strURL, strPARA) 'パラメーターを付けて開く Set oDocument = Nothing Set oDocument = CreateObject("htmlfile") oDocument.write strHTML '取得したHTMLをセット DoEvents Sleep 1000 '1秒待つ DoEvents '1R-12R 三連複の表を取り込む Dim r三連複の列 As Range '2022/10/01 一番人気を探すため Dim n一番人気 As Integer '一番人気の位置、受け取る。 Dim strWORK As String 'C1にセットする文字列を作る Dim n馬番1 As Integer '馬は最大18頭 Dim n馬番2 As Integer '馬は最大18頭 Dim str探す文字列 As String '1-2,2-3 など表題と比べる Dim str初回FLG As String '初回は三連複の文字をチェック、次からはレースのみで良い str初回FLG = "初回" '初回で初期化 '1Rから12Rまで、ループする。※これだと前日発売の時1Rでトラブルなぁ For nRACE = 1 To 12 '一から十二まで 'B5からのフラグが立っていたら And 最終じゃなければ 'レースを取り込む If Sheets("MENU").Range("B4").Offset(nRACE, 0) = 1 _ And Sheets("MENU").Range("B4").Offset(nRACE, 1) <> "最終" Then '出力先をクリアする 'まず、書き込み先シート、データをクリアする 'Sheets(nRACE & "R").Select 'シートの切り替え Sheets("作業用").Select 'シートの切り替え Cells.Delete Shift:=xlUp 'シート全体を削除する Range("A1").Select '先頭A1を選択する、 SET_Y = 0 'セット位置を初期化 strRACE = nRACE & "レース" '1Rなど 文字にする 'リンクから該当するレースを探しクリックする "1R".."12R" If str初回FLG = "初回" Then '初回はレースとワイドを探す 'リンクから、レースのTR行を探し、列 ここではワイドなどを返す strLINK = IE_Link_InnerHTML_InStr_TR_TD(oDocument, strRACE, "3連複") str初回FLG = "次はレース選択のみ" 'フラグを折る。何を入れてもいい Else '2回目以降は、レースのみ選択で良い。三連複オッズの場所にいるので 'リンクから該当するレースを探しクリックする "1R".."12R" 'Call IE_Link_InnerHTML_InStr_Click(oDocument, """" & strRACE & """") strLINK = IE_Link_InnerHTML_InStr_Click(oDocument, strRACE) End If If strLINK = "ERR" Then 'エラーチェック MsgBox strRACE & "が見つかりません" Stop End If strURL = "https://www.jra.go.jp" & 文字列切り出し(strLINK, "doAction('", "',") 'URL strPARA = "cname=" & 文字列切り出し(strLINK, "', '", "')") 'パラメーター strHTML = get_htmlfile_post(strURL, strPARA) 'パラメーターを付けて開く Set oDocument = Nothing Set oDocument = CreateObject("htmlfile") oDocument.write strHTML '取得したHTMLをセット DoEvents Sleep 1000 '1秒待つ DoEvents 'Call IE_WAIT(objIE) 'ページの表示完了を待ちます。 'レース番号をセルに書く SET_Y = SET_Y + 1 Cells(SET_Y, 1) = Sheets("MENU").Range("B2") & " " & strRACE Cells(SET_Y, 2) = JRA_Bodyからオッズの時刻を返す(oDocument) Sheets("MENU").Range("C4").Offset(nRACE, 0) = JRA_Bodyからオッズの時刻を返す(oDocument) Debug.Print "オッズ:" & JRA_Bodyからオッズの時刻を返す(oDocument) '発送時刻のセット 'JRA_Bodyから発走時刻を返す Sheets("MENU").Range("A4").Offset(nRACE, 0) = strRACE & "発走" & JRA_Bodyから発走時刻を返す(oDocument) Debug.Print strRACE & "発走:" & JRA_Bodyから発走時刻を返す(oDocument) SET_Y = SET_Y + 1 '三連複の表を取り込む 表、テーブルを探る '見出しをセルに書く 馬番 - 馬番 ワイドオッズ Cells(SET_Y, 1) = "馬番1" '三連複なので順位ではなく1,2,3 Cells(SET_Y, 2) = "馬番2" Cells(SET_Y, 3) = "馬番3" Cells(SET_Y, 4) = "三連複オッズ" SET_Y = SET_Y + 1 'テーブルを探す 'タグの取出しが、.getElementsByTagName("TABLE")で 可能なので、 For n馬番1 = 1 To 16 '馬番は最大18頭、16-17-18が最後なのでMAX16までループ For n馬番2 = n馬番1 + 1 To 17 '1-2-3 から 1-17-18, 2-3-4,,2-17-18 MAX最終は16-17-18 'TABLEタグを抜き 複数のテーブルをセット Set objTABLEs = oDocument.getElementsByTagName("TABLE") '↑で代入したオブジェクトからテーブルデータを取り出す。 '探す 1-2,1-3,,,16-17を作成する str探す文字列 = n馬番1 & "-" & n馬番2 Set objTABLE = Nothing 'オブジェクトを空にする For i = 0 To objTABLEs.Length - 1 'テーブル数分回す 'テーブルのcaptionが処理する1-2や1-3かチェック If objTABLEs(i).Caption.innerText = str探す文字列 Then '一致したテーブルGet Set objTABLE = objTABLEs(i) 'みつけたらi番目を代入 Exit For End If Next i '↑で見つかったかチェックする If objTABLE Is Nothing Then '見つからなかったら、終わっていたら、ループを抜ける Exit For '抜ける End If '表をDATAシートに書き出す 'テーブルからデータを抜き出す、書き出す For y = 0 To objTABLE.Rows.Length - 1 '行のループ 'データをセルに書く 馬番 馬番 馬番 三連複オッズ Cells(SET_Y, 1) = n馬番1 '馬番キャプション Cells(SET_Y, 2) = n馬番2 ' Cells(SET_Y, 3) = objTABLE.Rows(y).Cells(0).innerText '馬番 ここを馬番3にする Cells(SET_Y, 4) = objTABLE.Rows(y).Cells(1).innerText '三連複オッズ SET_Y = SET_Y + 1 Next y Next n馬番2 Cells(SET_Y, 1).Select '.Selecで位置を移動させると DoEvents '描画すると、遅くなるけど↑固まっているように見えるので Next n馬番1 SET_Y = SET_Y + 1 '空白を一行追加 '作業用シートからレース別に転記する Sheets(nRACE & "R").Select 'シートの切り替え '初回か判断 レース場や開催日が変わっているか判断 If Sheets("作業用").Range("A1") <> Range("A1") Then 'レース日や開催違いなら 'シートをクリア Cells.Delete Shift:=xlUp 'シート全体を削除する Range("A1").Select '先頭A1を選択する、 '初回は、開催場所、見出しもコピーする Sheets("作業用").Range("A1:D" & SET_Y).Copy 'SET_Yまでコピー Range("A1").Select ActiveSheet.Paste 'オッズの時刻をセット Sheets("作業用").Range("B1").Copy Range("D2").Select ActiveSheet.Paste Set r三連複の列 = Range("D2") '初回はD2をセット 2022/05/15 Else '二回目以降は、後ろに追記 '元データをコピー Sheets("作業用").Range("D2:D" & SET_Y).Copy 'オッズの列 '貼り付け先を探す For x = 1 To 256 '空白列を探す 'セル二行目のx列が空白か調べて抜ける If Len(Trim("" & Cells(2, x))) = 0 Then Exit For Next x Cells(2, x).Select '貼り付け先を選択 ActiveSheet.Paste Set r三連複の列 = Cells(2, x) '貼り付けたx列をセット 2022/05/15 '時刻を貼り付ける Sheets("作業用").Range("B1").Copy Cells(2, x).Select '貼り付け先を選択 ActiveSheet.Paste End If '10倍以下を赤に、小数点をそろえ、一番人気を探す 2022/10/01 n一番人気 = 三連複一番人気を探す(r三連複の列) '三連複の列から一番人気を探す strWORK = "三連複の一番人気は馬番 " strWORK = strWORK & " " & Range("a2").Offset(n一番人気, 0) strWORK = strWORK & " " & Range("a2").Offset(n一番人気, 1) strWORK = strWORK & " " & Range("a2").Offset(n一番人気, 2) strWORK = strWORK & " オッズは " & r三連複の列.Offset(n一番人気, 0) & " です" Range("c1") = strWORK '読み上げる※動画用 DoEvents Range("B1").Clear Range("A1,C1").Speak 'A1とC1を読み上げ End If 'フラグが立っていたら↑ Next 'MENUに戻り、保存 Sheets("MENU").Select Range("A3").Select ActiveWorkbook.Save End Sub '2022/10/01 追加 三連複の列 先頭(見出しの部分)を受け取り一番人気を返す Public Function 三連複一番人気を探す(r As Range) As Integer Dim オッズ As Double Dim 一番人気 As Integer Dim n As Integer '初期値を代入 オッズ = Val(r.Offset(1, 0)) '先頭のオッズを初期値にする 一番人気 = 1 '上から1番目を初期セット For n = 1 To 16 * 17 * 18 'MAX16*17*18まわす、といっても途中で抜けるならForじゃなくても・・ With r.Offset(n, 0) 'n下のセルを操作したり値を比べる If Len(Trim("" & .Value)) = 0 Then Exit For 'データ無しなら抜ける '100倍以下なら、赤にする 三連複は100倍以下を赤にする If Val(.Value) < 100 Then .Font.Color = -16776961 '赤にする End If 'オッズを比べる If Val(.Value) < オッズ Then '一時保存されているオッズより低かったら オッズ = Val(.Value) 'オッズを代入 更新 一番人気 = n '馬番nをセット End If End With Next 三連複一番人気を探す = 一番人気 'リターン値を返す '※まったく もう 日本語変数と関数名は良くないな・・・ End Function
関連する過去記事:
ken3memo.hatenablog.com
ken3memo.hatenablog.com
ken3memo.hatenablog.com
ken3memo.hatenablog.com