Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


30129 / 76732 ←次へ | 前へ→

【51873】Re:WEBクエリできないサイト
発言  ichinose  - 07/10/9(火) 7:39 -

引用なし
パスワード
   ▼ぶどう さん:
おはようございます。


>あとは、この処理を1000回繰り返すとして高速化のために、
>
>1. WEBの画像を表示しないで文字のみ取り込みできるか。又は画像が表示されるのを完全に待つことなく取り込み始めることができるか。

IE自体は非表示でも可能ですが、時間的な差はありませんでしたよ!!
但し、読み込みは全ての表示が完了しないと駄目ですよ!!

>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 "HTTP://stock.searchina.ne.jp/data/code.cgi?market=&code=" & Format(idx, "0000")
'         ↑頭のHTTPを半角小文字に修正後、実行すること
     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

私は、他人が作ったサイトからデータを取り出す というコードは遊びでしか
作ったことがありません。
もっと速い方法があるかもしれません。

0 hits

【51833】WEBクエリできないサイト ぶどう 07/10/6(土) 18:08 質問
【51856】Re:WEBクエリできないサイト ichinose 07/10/8(月) 8:59 発言
【51868】Re:WEBクエリできないサイト ぶどう 07/10/8(月) 20:44 お礼
【51873】Re:WEBクエリできないサイト ichinose 07/10/9(火) 7:39 発言
【51892】Re:WEBクエリできないサイト ぶどう 07/10/9(火) 20:13 お礼

30129 / 76732 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free