三流君 ken3のmemo置き場

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

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

XXXXXさんへ Q: Yahoo競馬の着順情報を取りたい A: DIV Class=XXXX を.ClassNameで取り出す テスト

' objTABLE.rows(行).cells(列)
Set objCELL = objTABLE.Rows(y).Cells(x) 'これがwebの列
で取り出したデータに対して、

さらに、その中から、DIVタグを取り出して、名前を調べる

'DIVタグを抜き classの名前を取得してみる
Set objDIVs = objCELL.getElementsByTagName("DIV")
'1セルの中からさらにDIVをByTagName("DIV")で取り出す。

そんなテスト動画です。
https://www.youtube.com/watch?v=a38aUY_4mNY
www.youtube.com

単純に要求を書くと、
Yahoo競馬 出馬表 過去の出走情報 を単純に(いつものように)
.InnerTEXTだけで取り出すと、
順位が取り出せない。
ソースをみると、順位が
div class="denmaCk i0103"
など、
class=
の名前になっている。

何言ってんだ、って感じですが

1.今まで通り、素直に取り出してみる

テストで
https://keiba.yahoo.co.jp/race/denma/2005050912/?page=2
の表を単純に取り出してみます。

2.テーブルの中から、さらにDIVタグをとりだしてみます
と言っても、
InnerTEXTに"頭"の文字があったら、
そのObjectからDIV指定でタグを取り出して、
(0)番目を .ClassNameで取り出しただけでした。

こんな感じで、
タグ(オブジェクト)の中からさらにタグを取り出せるので、
使ってみてください。

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で探してクリックする
Sub IE_Link_InnerHTML_InStr_Click(objIE As InternetExplorer, strINSTR As String)

    Dim i As Integer
    Dim objA As HTMLAnchorElement

    'リンクから受け取った文字列を探して押す
    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 イベントを発行
            Exit For '見つけたのでループを抜ける
        End If
    Next i

End Sub

'Yahoo競馬 出馬表 過去の出走情報 を取り出すテスト
'001 順位が単純なInnerTextだと取得できないことをテストする
Sub ie_Yahoo競馬の前走順位を取り出すテスト001()  '

'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 = 960    '横幅
    objIE.Height = 600   '高さ
    
'XXXバー、外観・外枠の調整。
    objIE.Toolbar = True     'タブの切り替えで必要なので、ツールバーを表示にする
    objIE.MenuBar = False    'メニューは非表示にする
    objIE.AddressBar = True  'URLなど アドレスバーは確認のため、表示する
    objIE.StatusBar = True   '一番下のステータスバーを表示。

   
'TOPページが表示されたので、表示された文章に対して、処理を行います。
       
    Dim i     As Integer '添え字 i番目などで使用
    Dim yLINE As Integer '行カウンタ、Y行目
    
    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

'表を取り込む
    'テスト用のシートに切り替え、データを消す
    Sheets("作業用").Select
    Cells.Select
    Range("A1").Activate
    Selection.ClearContents
    Range("A1").Select


    '↑クリア後、一行目に目的の列名をシートに書く

'TEST ページの表示
    '処理したいページを表示します。
    'ここでは、固定のページにしていますが、
    'アレンジしてみてください。
    objIE.Navigate "https://keiba.yahoo.co.jp/race/denma/2005050912/?page=2"  '.Navigate メソッドで 表示する。

    Call IE_WAIT(objIE)   'ページの表示完了を待ちます。

    '表を取り込む
    '表、テーブルを探る
    'テーブルを探す
    'タグの取出しが、.getElementsByTagName("TABLE")で 可能なので、
    
    'TABLEタグを抜き 複数のテーブルをセット
    Set objTABLEs = objIE.Document.getElementsByTagName("TABLE")
    '↑で代入したオブジェクトからテーブルデータを取り出す。
    
    Set objTABLE = Nothing  'オブジェクトを空にする
    For i = 0 To objTABLEs.Length - 1  'テーブル数分回す
        'web上の表、一行目に目的の列が存在するかチェックする
        For x = 0 To objTABLEs(i).Rows(0).Cells.Length - 1  'web上の表、列数分ループ
            ' objTABLE.rows(行).cells(列)
            Set objCELL = objTABLEs(i).Rows(0).Cells(x)

            '一行目に前走の見出し列があるか?チェックする
            If objCELL.innerText = "前走" Then '列が見つかったら
                Set objTABLE = objTABLEs(i)  'i番目のテーブルを代入
                Exit For
            End If
            
            If Not (objTABLE Is Nothing) Then Exit For  'テーブルが見つかっていたら抜ける
        Next x
        If Not (objTABLE Is Nothing) Then Exit For  'テーブルが見つかっていたら抜ける
    Next i
    
    '↑で見つかったかチェックする
    If objTABLE Is Nothing Then
        MsgBox "過去の出走情報 から 前走が見つかりません"
        Exit Sub  'エラー表示して抜ける
    End If
    
    '表をDATAシートに書き出す
    
    'カウンタを初期化
    SET_Y = 1
    SET_X = 1
    
    'Webの表をシートへ転記(代入する)
    For y = 0 To objTABLE.Rows.Length - 1  '行のループ ※y=1で二行目からループ
        For x = 0 To objTABLE.Rows(y).Cells.Length - 1  '列数分ループ
            ' objTABLE.rows(行).cells(列)
            Set objCELL = objTABLE.Rows(y).Cells(x) 'これがwebの列
            SET_X = x + 1 'セットする列
            Cells(SET_Y, SET_X) = objCELL.innerText 'データセット
        Next
        SET_Y = SET_Y + 1
    Next
    SET_Y = SET_Y + 1  '空白を一行追加
    
        
'処理が終わったので、IEを閉じます。
    'テストの時は、↓確認して、残しておくと便利ですよ。
    If MsgBox("処理終了、IEを閉じますか?", vbYesNo) = vbYes Then '終了確認
        objIE.Quit  '.Quitで閉じる
    End If
    
    Set objIE = Nothing '使用したオブジェクト変数もキレイにしてね。
   
End Sub



'Yahoo競馬 出馬表 過去の出走情報 を取り出すテスト
'002 順位をDIV の div class="denmaCk i0101 から取り出す
Sub ie_Yahoo競馬の前走順位を取り出すテスト002()  '

'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 = 960    '横幅
    objIE.Height = 600   '高さ
    
'XXXバー、外観・外枠の調整。
    objIE.Toolbar = True     'タブの切り替えで必要なので、ツールバーを表示にする
    objIE.MenuBar = False    'メニューは非表示にする
    objIE.AddressBar = True  'URLなど アドレスバーは確認のため、表示する
    objIE.StatusBar = True   '一番下のステータスバーを表示。

   
'TOPページが表示されたので、表示された文章に対して、処理を行います。
       
    Dim i     As Integer '添え字 i番目などで使用
    Dim yLINE As Integer '行カウンタ、Y行目
    
    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 strSETDATA As String   'セットするデータ
    Dim objDIVs As Object 'DIV複数の格納用
    Dim strRIGHT2 As String  '名前の右端 二文字を取り出す、着順保管用

'表を取り込む
    'テスト用のシートに切り替え、データを消す
    Sheets("作業用").Select
    Cells.Select
    Range("A1").Activate
    Selection.ClearContents
    Range("A1").Select


    '↑クリア後、一行目に目的の列名をシートに書く

'TEST ページの表示
    '処理したいページを表示します。
    'ここでは、固定のページにしていますが、
    'アレンジしてみてください。
    objIE.Navigate "https://keiba.yahoo.co.jp/race/denma/2005050912/?page=2"  '.Navigate メソッドで 表示する。

    Call IE_WAIT(objIE)   'ページの表示完了を待ちます。

    '表を取り込む
    '表、テーブルを探る
    'テーブルを探す
    'タグの取出しが、.getElementsByTagName("TABLE")で 可能なので、
    
    'TABLEタグを抜き 複数のテーブルをセット
    Set objTABLEs = objIE.Document.getElementsByTagName("TABLE")
    '↑で代入したオブジェクトからテーブルデータを取り出す。
    
    Set objTABLE = Nothing  'オブジェクトを空にする
    For i = 0 To objTABLEs.Length - 1  'テーブル数分回す
        'web上の表、一行目に目的の列が存在するかチェックする
        For x = 0 To objTABLEs(i).Rows(0).Cells.Length - 1  'web上の表、列数分ループ
            ' objTABLE.rows(行).cells(列)
            Set objCELL = objTABLEs(i).Rows(0).Cells(x)

            '一行目に前走の見出し列があるか?チェックする
            If objCELL.innerText = "前走" Then '列が見つかったら
                Set objTABLE = objTABLEs(i)  'i番目のテーブルを代入
                Exit For
            End If
            
            If Not (objTABLE Is Nothing) Then Exit For  'テーブルが見つかっていたら抜ける
        Next x
        If Not (objTABLE Is Nothing) Then Exit For  'テーブルが見つかっていたら抜ける
    Next i
    
    '↑で見つかったかチェックする
    If objTABLE Is Nothing Then
        MsgBox "過去の出走情報 から 前走が見つかりません"
        Exit Sub  'エラー表示して抜ける
    End If
    
    '表をDATAシートに書き出す
    
    'カウンタを初期化
    SET_Y = 1
    SET_X = 1
    
    'Webの表をシートへ転記(代入する)
    For y = 0 To objTABLE.Rows.Length - 1  '行のループ ※y=1で二行目からループ
        For x = 0 To objTABLE.Rows(y).Cells.Length - 1  '列数分ループ
            ' objTABLE.rows(行).cells(列)
            Set objCELL = objTABLE.Rows(y).Cells(x) 'これがwebの列
            
            strSETDATA = objCELL.innerText  'TDやTHのテキストを取り出す
            If InStr(strSETDATA, "頭") > 0 Then  'n頭 の頭を探して見つかったら
                '前走の順位を探す
                'DIVタグを抜き classの名前を取得してみる
                Set objDIVs = objCELL.getElementsByTagName("DIV")
                '1セルの中からさらにDIVをByTagName("DIV")で取り出す。
                '取り出したDIVが1以上なら、名前の右端二桁を取り出し順位とする
                If objDIVs.Length > 0 Then
                    strRIGHT2 = Right(objDIVs(0).className, 2)
                    '頭のテキストを着順付きで置き換える
                    strSETDATA = Replace(strSETDATA, "頭", "頭 " & strRIGHT2 & "着 ")
                End If
            End If
            SET_X = x + 1 'セットする列
            Cells(SET_Y, SET_X) = strSETDATA 'データセット
        Next
        SET_Y = SET_Y + 1
    Next
    SET_Y = SET_Y + 1  '空白を一行追加
    
        
'処理が終わったので、IEを閉じます。
    'テストの時は、↓確認して、残しておくと便利ですよ。
    If MsgBox("処理終了、IEを閉じますか?", vbYesNo) = vbYes Then '終了確認
        objIE.Quit  '.Quitで閉じる
    End If
    
    Set objIE = Nothing '使用したオブジェクト変数もキレイにしてね。
   
End Sub

Ken3 ホームページ 目次

分類:HPを大きく分けると4つの柱(分類)です。
・[Excel/Access VBA]の解説
・[ASP(Active Server Pages)]の解説。
・[元コンビニ店長時代の話]が弟に巻き込まれ、失敗した脱サラ、畑違い?の仕事で失敗。
・[プログラマーの愚痴]では、あまり見せたくない三流プログラマーの内面かな。
三流君を踏み台にする
主に上記4つの分類でHP作成やメルマガの発行を行ってます。
※更新頻度が落ちていて情報の鮮度が悪いです。



Googleを使用して検索する

読者の声:三流君の説明・解説じゃ よくわからなかったから、Googleを使って、自分で検索します。
三流君:残念です。あっ、下記にGoogleの検索窓を設置しました。
いろいろ指定して試してみてください。

Google
探す言葉:気になる単語や,オブジェクト(Document),プロパティ(.Busy)やメソッド(.Navigate)などを入れて検索してみてください。


言語を指定:見つからない時は指定無しで探す

サイト指定:人気QAサイト や 一次情報MS本家を指定する
一次情報・二次情報まとめから探る
QAサイトの質問から探る
検索実行: ←オプション確認後に検索ボタンを押してください

期間指定:情報の鮮度も大切?
検索実行: ←オプション確認後に検索ボタンを押してください


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