三流君 ken3のmemo置き場

三流プログラマーのメモ書きです。主にVBAやWindowsの話題が多いです

挨拶・自己紹介:
失敗続きのAB型の変わり者 :三流プログラマー Ken3です
フリーのエンジニア・個人事業主です・・と書くと聞こえはイイが(それとなくカッコよく聞こえるが)、 現在は小さな案件の受注請負 と 短期派遣 で 日々つつましく?ほそぼそと暮らしてます。

よく検索されるキーワード: [質問回答XXXXさんへ] [CreateObject] [VBA] [JRA競馬オッズ]

JRA三連複のオッズ取得 JRAのHPから三連複のオッズをExcelに取り込む デバッグ

ワイドと三連複のオッズを取得したい
と質問があったので、
今回は、三連複のオッズ取得に挑戦してみます。

下記、デバッグ動画です、うまくコードをアレンジしてみてください。
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

Ken3 ホームページ 目次

分類:HPを大きく分けると4つの柱(分類)です。

  1. [VBA・マクロ プログラミング]の解説
    当店の人気はVBA系のCreateObject("XXXXXX.application")で他のアプリケーションを操作するサンプルが人気です
  2. [プログラマーの愚痴]では、あまり見せたくない三流プログラマーの内面かな。
    三流君を踏み台にする
  3. [古いクラシック ASP(Active Server Pages)]の解説。
  4. [元コンビニ店長時代の話]が弟に巻き込まれ、失敗した脱サラ、畑違い?の仕事で失敗。
主に上記4つの分類でHP作成やメルマガの発行を行ってます。
※更新頻度が落ちていて情報の鮮度が悪いです。



本当に三流なんです(笑):たまにスゴイですねなんて言われることもありますが、
真実は→ [三流君の真実は...] ←を初めに見てくださるとわかると思います。
(からくりは、成功例↑しか載せてなくて ヒドイ失敗例はお蔵入り迷宮入りが多かったりします)