' 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
