Excel VBA質問箱 IV

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

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


7264 / 76732 ←次へ | 前へ→

【75057】WebQuery自動再計算手動の設定
質問  Excel2002愛好家  - 13/11/30(土) 15:14 -

引用なし
パスワード
   WebQuery の際、再計算手動に設定しても、「再計算」が入ってしまいます。
取得データが少ないときは1分以内で終わっていたのですが、130銘柄の取得では数十分かかってしまいます。

Application.Calculation = xlManual
を使っても再計算してしまいます。

Googleで調べても、なかなか解決につながるページを見つけることができなかったので質問をさせてください。

Sub set終値()
Dim t As Single
Dim RightEnd As Range
Dim cnt As Long
Dim y, myCode  
  
  Sheets("株価入力").Select  
  t = Timer
  Application.ScreenUpdating = False
  Application.Calculation = xlManual   '再計算手動コでも40分以上 コメントアウトでも40分以上

  Sheets("作業").Select
  With Sheets("株価入力")
    myCode = .Range("A4", .Cells(.Rows.Count, 1).End(xlUp)).Value  '銘柄コードのセル群
    Set RightEnd = .Cells(4, 256).End(xlToLeft)     '前日終値のTopCell
    y = RightEnd.Resize(UBound(myCode, 1), 1).Value   '前日終値
    For Each v In myCode
      cnt = cnt + 1
      Select Case v
      Case ""
        y(cnt, 1) = Empty      '終値
      Case Else
        y(cnt, 1) = Get終値(v)   '終値
      End Select
    Next
  End With
  '
  RightEnd.Resize(cnt, 1).Value = y        '終値

  Application.Calculation = xlAutomatic    '再計算自動 1.
  Application.ScreenUpdating = True
  Sheets("株価入力").Select
  t = Timer - t
  MsgBox Int(t / 60) & " 分 " & (t Mod 60) & " 秒 " & " かかりました"
End Sub

Function Get終値(code As Variant)
Dim webURL As String
Dim r As Range

  webURL = "URL;ht  tp://stocks.finance.yahoo.co.jp/stocks/detail/?code=" & code
  
  'Sheets("作業").Select
  With ActiveSheet.QueryTables.Add(Connection:=webURL, Destination:=Range("A1"))
    .WebSelectionType = xlEntirePage    '全て取り込み  '削除 表のみ取り込み 2.
    .WebFormatting = xlWebFormattingNone
    .WebPreFormattedTextToColumns = True
    .WebConsecutiveDelimitersAsOne = True
    .Refresh BackgroundQuery:=False
  End With
  '
  '---'終値取り込み
  Set r = FindCell("詳細情報")
  If r Is Nothing Then
    Get終値 = Empty
  Else
    Get終値 = c.Offset(-1, 2).Value 
  End If
  '
  Sheets("作業").Cells.Clear
  Sheets("作業").Cells.QueryTable.Delete
  Set r = Nothing
End Function

Public Function FindCell(key As String) As Range
  Set FindCell = Sheets("作業").Columns("A:A").Find(What:=key, LookAt:=xlPart)
End Function
279 hits

【75057】WebQuery自動再計算手動の設定 Excel2002愛好家 13/11/30(土) 15:14 質問
【75058】Re:WebQuery自動再計算手動の設定 kanabun 13/12/1(日) 7:41 発言
【75059】Re:WebQuery自動再計算手動の設定 Excel2002愛好家 13/12/1(日) 8:52 質問
【75062】Re:WebQuery自動再計算手動の設定 Excel2002愛好家 13/12/2(月) 22:58 発言

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