| |
▼ぶどう さん：
おはようございます。
>あとは、この処理を1000回繰り返すとして高速化のために、
>
>1. WEBの画像を表示しないで文字のみ取り込みできるか。又は画像が表示されるのを完全に待つことなく取り込み始めることができるか。
ＩＥ自体は非表示でも可能ですが、時間的な差はありませんでしたよ！！
但し、読み込みは全ての表示が完了しないと駄目ですよ！！
>2. 1セル毎の記入式の取り込みではなく、WEBの文字部分全体（特定の表だけでなくてよいので）一括取り込みできるか。
テキストデータの一括での取得は可能です。
例
ie.document.body.innertext
等とすると表示されているテキストを一括で取得できますが、
それぞれの内容に分割しなければなりません
（いや、分割できれば良いですが、区切り文字がなくてできない場合もあります）。
よって、表の要素を一つずつ取得する方法しか思い浮かびませんでした。
但し、以下のコードで私の環境ではWebクエリと大きい時間差はありませんでしたよ！！
'======================================
Sub main2()
On Error Resume Next
Dim ret As Long
Dim ie As Object
Dim tbl As Object
Dim rw As Object
Dim cll As Object
Dim idx As Long
Dim g0 As Long, g1 As Long
Dim wk1, wk2
Application.ScreenUpdating = False
Set ie = CreateObject("InternetExplorer.Application")
With ie
.Visible = False
idx = 1
For idx = 1 To 5 '←これで 0001〜0005までを表示
.navigate "ＨＴＴＰ://stock.searchina.ne.jp/data/code.cgi?market=&code=" & Format(idx, "0000")
' ↑頭のＨＴＴＰを半角小文字に修正後、実行すること
Do While .Busy = True Or .readyState <> 4
Loop
For Each tbl In .document.body.all
If TypeName(tbl) = "HTMLTable" Then
Err.Clear
wk1 = "": wk2 = ""
wk1 = Trim(tbl.Rows(0).Cells(0).innertext)
wk2 = Trim(tbl.Rows(1).Cells(0).innertext)
ret = 1
If Mid(wk1, 1, 4) = Format(idx, "0000") Then
Cells(g0 + 1, 1).Value = tbl.Rows(0).Cells(0).innertext
g0 = g0 + 1
ret = 1
ElseIf wk2 = "現在値" Then
ret = 0
ElseIf wk2 = "売り気配" Then
ret = 0
ElseIf wk2 = "現在値の円換算" Then
ret = 0
End If
If ret = 0 Then
For Each rw In tbl.Rows
g1 = 0
For Each cll In rw.Cells
Cells(g0 + 1, g1 + 1).Value = cll.innertext
g1 = g1 + 1
Next
g0 = g0 + 1
Next
End If
End If
Next
g0 = g0 + 1
Next
.Quit
End With
Range(Columns(1), Columns(2)).AutoFit
Set tbl = Nothing
Set ie = Nothing
Set rw = Nothing
Set cll = Nothing
Application.ScreenUpdating = True
End Sub
私は、他人が作ったサイトからデータを取り出す というコードは遊びでしか
作ったことがありません。
もっと速い方法があるかもしれません。
|
|
![[未読]](./data/excel/image/read_icon.gif){kind=icon}
