Excel VBA質問箱 IV

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

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


1331 / 13644 ツリー ←次へ | 前へ→

【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 発言[未読]

【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

【75058】Re:WebQuery自動再計算手動の設定
発言  kanabun  - 13/12/1(日) 7:41 -

引用なし
パスワード
   ▼Excel2002愛好家 さん:

あてずっぽですみませんけど、


>Function Get終値(code As Variant)
>    .WebPreFormattedTextToColumns = True
>    .WebConsecutiveDelimitersAsOne = True
>    .Refresh BackgroundQuery:=False
     .Delete 'クエリを切断
>  End With

としたらどうなります?

【75059】Re:WebQuery自動再計算手動の設定
質問  Excel2002愛好家  - 13/12/1(日) 8:52 -

引用なし
パスワード
    kanabunさんおはようございます。投稿ありがとうございます。

    .Delete   'クエリを切断●

を試してみましたが、処理時間は改善されませんでした。

これは(3)と同じ内容かな?と思うのですが

  Sheets("作業").Cells.QueryTable.Delete    '(3)


色々試しているなかで、下記のことが分かっています。
'ESCでプログラムを止めて、(1)(2)のコメントアウトを入れ替えるとプロジェクトがリセットされ、速くなった

劇的に速くなります。

ただ、残念なことに、この修正をしても、ファイルを保存して、再度開いて使うと、元の木阿弥で
処理時間が数十分かかってしまいます。
毎回プログラムをESCで中断し、1.2.のコメントアウトを入れ替えるのは絶対にしたくないです。

マクロでできる良い解決策があれば助かります。よろしくお願いします。


  'Sheets("作業").Select
  '             'ESCで止めて、(1)(2)のコメントアウトを入れ替えるとプロジェクトがリセットされ、速くなった
  With ActiveSheet.QueryTables.Add(Connection:=webURL, Destination:=Range("A1"))          '(1) ●書き換えで 1分28秒
  'With Sheets("作業").QueryTables.Add(Connection:=webURL, Destination:=Sheets("作業").Range("A1"))   '(2) ●書き換えで 1分30秒
    .WebSelectionType = xlEntirePage    
    .WebFormatting = xlWebFormattingNone
    .WebPreFormattedTextToColumns = True
    .WebConsecutiveDelimitersAsOne = True
    .Refresh BackgroundQuery:=False
    .Delete   'クエリを切断●
  End With
  '


  Sheets("作業").Cells.Clear
  'Sheets("作業").Cells.QueryTable.Delete    '(3)
  Set r = Nothing
End Function

【75062】Re:WebQuery自動再計算手動の設定
発言  Excel2002愛好家  - 13/12/2(月) 22:58 -

引用なし
パスワード
   皆さん 今晩は。自己解決しました。
投稿すると、刺激になって解決できるものですね。投稿して良かったです。

kanabunさんの Delete がヒントになって、いろいろ試していると、
クエリの切断が、下記の(1)でできました。

Sheets("作業").Cells.Delete
でシートが完全にリセットされ、クエリの切断ができたのかな。

  'Sheets("作業").Cells.Clear       'カット
  'Sheets("作業").Cells.QueryTable.Delete 'カット
では、クエリの残骸が残っていて処理に時間がかかっていたのだと思います。


Sub set終値() 
  
   省略
   Application.ScreenUpdating = False
  'Application.Calculation = xlManual   'カット

  省略

  'Application.Calculation = xlAutomatic  'カット
   Application.ScreenUpdating = True

   省略

End Sub

Function Get終値(code As Variant)

  省略
  
  With ActiveSheet.QueryTables.Add(Connection:=webURL, Destination:=Range("A1"))
    .WebSelectionType = xlEntirePage    '全て取り込み  '削除 表のみ取り込み 2.
    .WebFormatting = xlWebFormattingNone
    .WebPreFormattedTextToColumns = True
    .WebConsecutiveDelimitersAsOne = True
    .Refresh BackgroundQuery:=False
  End With

  省略

  'Sheets("作業").Cells.Clear       'カット
  'Sheets("作業").Cells.QueryTable.Delete 'カット

   Sheets("作業").Cells.Delete  '(1)これでクエリを切断できました

End Function

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