| |
おはようございます。
>やりたいこと：
> 以下のホームページから
> レース情報（日付・天候・競走データ・払い戻し情報）
> などをすべて抽出し、エクセルに貼り付ける。
>
>ｈｔｔｐ://keiba.nifty.com/cs/catalog/keiba_placing-order-past
>/result-PC/kaisai_09070102/raceNo_01/1.htm
競争データだけ
'=========================================================
Sub main2()
On Error Resume Next
Dim ie As Object
Dim tbl As Object
Dim rw As Object
Dim cll As Object
Dim g0 As Long, g1 As Long
Application.ScreenUpdating = False
Set ie = CreateObject("InternetExplorer.Application")
With ie
.Visible = False
.navigate "ｈｔｔｐ://keiba.nifty.com/cs/catalog/keiba_placing-order-past/result-PC/kaisai_09070102/raceNo_01/1.htm"
' ｈｔｔｐは、直してください
Do While .Busy = True Or .readyState <> 4
Loop
For Each tbl In .document.body.all.tags("Table")
If tbl.className = "umaList" Then
For Each rw In tbl.Rows
g1 = 0
For Each cll In rw.Cells
Cells(g0 + 1, g1 + 1).Value = Replace(cll.innertext, vbCr, "")
g1 = g1 + 1
Next
g0 = g0 + 1
Next
End If
Next
.Quit
End With
Set tbl = Nothing
Set ie = Nothing
Set rw = Nothing
Set cll = Nothing
Application.ScreenUpdating = True
End Sub
尚、
'====================================
Sub main()
On Error Resume Next
Dim ie As Object
Dim ele As Object
Dim g0 As Long
Set ie = CreateObject("InternetExplorer.Application")
With ie
.Visible = True
.navigate "ｈｔｔｐ://keiba.nifty.com/cs/catalog/keiba_placing-order-past/result-PC/kaisai_09070102/raceNo_01/1.htm"
Do While .Busy = True Or .readyState <> 4
Loop
For Each ele In .document.body.all
Cells(g0 + 1, 1).Value = TypeName(ele)
Cells(g0 + 1, 2).Value = ele.innertext
Cells(g0 + 1, 3).Value = ele.tagName
Cells(g0 + 1, 4).Value = ele.className
g0 = g0 + 1
Next
.Quit
End With
Set ele = Nothing
Set ie = Nothing
End Sub
こんなコードでElementの内容を調べると、他の部分も取得できそうですよ
上記の最初の競争データ取得もIHTMLElementCollectionを調べて取得しました。
|
|
![[未読]](./data/excel/image/read_icon.gif){kind=icon}
